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.287 by root, Mon Jun 5 05:31:13 2006 UTC vs.
Revision 1.345 by root, Sun Aug 13 21:46:10 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
…		…
851	}	909	}
852		910
853	sub _draw {	911	sub _draw {
854	my ($self) = @_;	912	my ($self) = @_;
855		913
856	my ($w, $h) = @$self{qw(w h)};
857
858	my $tex = $self->{texture}	914	my $tex = $self->{texture}
859	or return;	915	or return;
860		916
861	glEnable GL_TEXTURE_2D;	917	glEnable GL_TEXTURE_2D;
862	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	918	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
863	glColor 0, 0, 0, 1;	919	glColor 0, 0, 0, 1;
864		920
865	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	921	$tex->draw_quad_alpha_premultiplied (0, 0);
866		922
867	glDisable GL_TEXTURE_2D;	923	glDisable GL_TEXTURE_2D;
868	}	924	}
869		925
870	#############################################################################	926	#############################################################################
871		927
872	package CFClient::UI::ViewPort;	928	package CFPlus::UI::ViewPort;
873		929
874	our @ISA = CFClient::UI::Window::;	930	our @ISA = CFPlus::UI::Window::;
875		931
876	sub new {	932	sub new {
877	my $class = shift;	933	my $class = shift;
878		934
879	$class->SUPER::new (	935	$class->SUPER::new (
…		…
892	$h = 10 if $self->{scroll_y};	948	$h = 10 if $self->{scroll_y};
893		949
894	($w, $h)	950	($w, $h)
895	}	951	}
896		952
897	sub size_allocate {	953	sub invoke_size_allocate {
898	my ($self, $w, $h) = @_;	954	my ($self, $w, $h) = @_;
899		955
900	my $child = $self->child;	956	my $child = $self->child;
901		957
902	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};	958	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
903	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};	959	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
904		960
905	$self->child->configure (0, 0, $w, $h);	961	$self->child->configure (0, 0, $w, $h);
906	$self->update;	962	$self->update;
		963
		964	1
907	}	965	}
908		966
909	sub set_offset {	967	sub set_offset {
910	my ($self, $x, $y) = @_;	968	my ($self, $x, $y) = @_;
911		969
…		…
937	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}	995	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
938	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}	996	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
939	) {	997	) {
940	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})	998	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
941	} else {	999	} else {
942	$self->CFClient::UI::Base::find_widget ($x, $y)	1000	$self->CFPlus::UI::Base::find_widget ($x, $y)
943	}	1001	}
944	}	1002	}
945		1003
946	sub _render {	1004	sub _render {
947	my ($self) = @_;	1005	my ($self) = @_;
948		1006
949	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};	1007	local $CFPlus::UI::Base::draw_x = $CFPlus::UI::Base::draw_x - $self->{view_x};
950	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};	1008	local $CFPlus::UI::Base::draw_y = $CFPlus::UI::Base::draw_y - $self->{view_y};
951		1009
952	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	1010	CFPlus::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
953		1011
954	$self->SUPER::_render;	1012	$self->SUPER::_render;
955	}	1013	}
956		1014
957	#############################################################################	1015	#############################################################################
958		1016
959	package CFClient::UI::ScrolledWindow;	1017	package CFPlus::UI::ScrolledWindow;
960		1018
961	our @ISA = CFClient::UI::HBox::;	1019	our @ISA = CFPlus::UI::HBox::;
962		1020
963	sub new {	1021	sub new {
964	my ($class, %arg) = @_;	1022	my ($class, %arg) = @_;
965		1023
966	my $child = delete $arg{child};	1024	my $child = delete $arg{child};
967		1025
968	my $self;	1026	my $self;
969		1027
970	my $slider = new CFClient::UI::Slider	1028	my $slider = new CFPlus::UI::Slider
971	vertical => 1,	1029	vertical => 1,
972	range => [0, 0, 1, 0.01], # HACK fix	1030	range => [0, 0, 1, 0.01], # HACK fix
973	on_changed => sub {	1031	on_changed => sub {
974	$self->{vp}->set_offset (0, $_[1]);	1032	$self->{vp}->set_offset (0, $_[1]);
975	},	1033	},
976	;	1034	;
977		1035
978	$self = $class->SUPER::new (	1036	$self = $class->SUPER::new (
979	vp => (new CFClient::UI::ViewPort expand => 1),	1037	vp => (new CFPlus::UI::ViewPort expand => 1),
		1038	can_events => 1,
980	slider => $slider,	1039	slider => $slider,
981	%arg,	1040	%arg,
982	);	1041	);
983		1042
984	$self->SUPER::add ($self->{vp}, $self->{slider});	1043	$self->SUPER::add ($self->{vp}, $self->{slider});
985	$self->add ($child) if $child;	1044	$self->add ($child) if $child;
986		1045
987	$self	1046	$self
988	}	1047	}
989		1048
		1049	#TODO# update range on size_allocate depending on child
		1050
990	sub add {	1051	sub add {
991	my ($self, $widget) = @_;	1052	my ($self, $widget) = @_;
992		1053
993	$self->{vp}->add ($self->{child} = $widget);	1054	$self->{vp}->add ($self->{child} = $widget);
994	}	1055	}
995		1056
		1057	sub invoke_mouse_wheel {
		1058	my ($self, $ev) = @_;
		1059
		1060	return 0 unless $ev->{dy}; # only vertical movements
		1061
		1062	$self->{slider}->emit (mouse_wheel => $ev);
		1063
		1064	1
		1065	}
		1066
		1067	sub update_slider {
		1068	my ($self) = @_;
		1069
		1070	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
		1071	}
		1072
996	sub update {	1073	sub update {
997	my ($self) = @_;	1074	my ($self) = @_;
998		1075
999	$self->SUPER::update;	1076	$self->SUPER::update;
1000		1077
1001	# todo: overwrite size_allocate of child	1078	$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	}	1079	}
1005		1080
1006	sub size_allocate {	1081	sub invoke_size_allocate {
1007	my ($self, $w, $h) = @_;	1082	my ($self, $w, $h) = @_;
1008		1083
		1084	$self->update_slider;
		1085
1009	$self->SUPER::size_allocate ($w, $h);	1086	$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	}	1087	}
1014
1015	#TODO# update range on size_allocate depending on child
1016	# update viewport offset on scroll
1017		1088
1018	#############################################################################	1089	#############################################################################
1019		1090
1020	package CFClient::UI::Frame;	1091	package CFPlus::UI::Frame;
1021		1092
1022	our @ISA = CFClient::UI::Bin::;	1093	our @ISA = CFPlus::UI::Bin::;
1023		1094
1024	use CFClient::OpenGL;	1095	use CFPlus::OpenGL;
1025		1096
1026	sub new {	1097	sub new {
1027	my $class = shift;	1098	my $class = shift;
1028		1099
1029	$class->SUPER::new (	1100	$class->SUPER::new (
…		…
1055	$self->SUPER::_draw;	1126	$self->SUPER::_draw;
1056	}	1127	}
1057		1128
1058	#############################################################################	1129	#############################################################################
1059		1130
1060	package CFClient::UI::FancyFrame;	1131	package CFPlus::UI::FancyFrame;
1061		1132
1062	our @ISA = CFClient::UI::Bin::;	1133	our @ISA = CFPlus::UI::Bin::;
1063		1134
1064	use CFClient::OpenGL;	1135	use CFPlus::OpenGL;
1065		1136
1066	my $bg =	1137	my $bg =
1067	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",	1138	new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png",
1068	mipmap => 1, wrap => 1;	1139	mipmap => 1, wrap => 1;
1069		1140
1070	my @border =	1141	my @border =
1071	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1142	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);	1143	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1073		1144
1074	sub new {	1145	sub new {
1075	my ($class, %arg) = @_;	1146	my ($class, %arg) = @_;
1076
1077	my $title = delete $arg{title};
1078		1147
1079	my $self = $class->SUPER::new (	1148	my $self = $class->SUPER::new (
1080	bg => [1, 1, 1, 1],	1149	bg => [1, 1, 1, 1],
1081	border_bg => [1, 1, 1, 1],	1150	border_bg => [1, 1, 1, 1],
1082	border => 0.6,	1151	border => 0.6,
1083	can_events => 1,	1152	can_events => 1,
1084	min_w => 16,	1153	min_w => 64,
1085	min_h => 16,	1154	min_h => 32,
1086	%arg,	1155	%arg,
1087	);	1156	);
1088		1157
1089	$self->{title} = new CFClient::UI::Label	1158	$self->{title_widget} = new CFPlus::UI::Label
1090	align => 0,	1159	align => 0,
1091	valign => 1,	1160	valign => 1,
1092	text => $title,	1161	text => $self->{title},
1093	fontsize => $self->{border}	1162	fontsize => $self->{border},
1094	if defined $title;	1163	if exists $self->{title};
		1164
		1165	if ($self->{has_close_button}) {
		1166	$self->{close_button} =
		1167	new CFPlus::UI::ImageButton
		1168	path => 'x1_close.png',
		1169	on_activate => sub { $self->emit ("delete") };
		1170
		1171	$self->CFPlus::UI::Container::add ($self->{close_button});
		1172	}
1095		1173
1096	$self	1174	$self
1097	}	1175	}
1098		1176
1099	sub add {	1177	sub add {
1100	my ($self, @widgets) = @_;	1178	my ($self, @widgets) = @_;
1101		1179
1102	$self->SUPER::add (@widgets);	1180	$self->SUPER::add (@widgets);
		1181	$self->CFPlus::UI::Container::add ($self->{close_button}) if $self->{close_button};
1103	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};	1182	$self->CFPlus::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1104	}	1183	}
1105		1184
1106	sub border {	1185	sub border {
1107	int $_[0]{border} * $::FONTSIZE	1186	int $_[0]{border} * $::FONTSIZE
1108	}	1187	}
1109		1188
1110	sub size_request {	1189	sub size_request {
1111	my ($self) = @_;	1190	my ($self) = @_;
1112		1191
1113	$self->{title}->size_request	1192	$self->{title_widget}->size_request
1114	if $self->{title};	1193	if $self->{title_widget};
		1194
		1195	$self->{close_button}->size_request
		1196	if $self->{close_button};
1115		1197
1116	my ($w, $h) = $self->SUPER::size_request;	1198	my ($w, $h) = $self->SUPER::size_request;
1117		1199
1118	(	1200	(
1119	$w + $self->border * 2,	1201	$w + $self->border * 2,
1120	$h + $self->border * 2,	1202	$h + $self->border * 2,
1121	)	1203	)
1122	}	1204	}
1123		1205
1124	sub size_allocate {	1206	sub invoke_size_allocate {
1125	my ($self, $w, $h) = @_;	1207	my ($self, $w, $h) = @_;
1126		1208
1127	if ($self->{title}) {	1209	if ($self->{title_widget}) {
1128	$self->{title}{w} = $w;	1210	$self->{title_widget}{w} = $w;
1129	$self->{title}{h} = $h;	1211	$self->{title_widget}{h} = $h;
1130	$self->{title}->size_allocate ($w, $h);	1212	$self->{title_widget}->invoke_size_allocate ($w, $h);
1131	}	1213	}
1132		1214
1133	my $border = $self->border;	1215	my $border = $self->border;
1134		1216
1135	$h -= List::Util::max 0, $border * 2;	1217	$h -= List::Util::max 0, $border * 2;
1136	$w -= List::Util::max 0, $border * 2;	1218	$w -= List::Util::max 0, $border * 2;
		1219
		1220	$self->child->configure ($border, $border, $w, $h);
		1221
		1222	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1223	if $self->{close_button};
		1224
		1225	1
		1226	}
		1227
		1228	sub invoke_delete {
		1229	my ($self) = @_;
		1230
		1231	$self->hide;
1137		1232
1138	$self->child->configure ($border, $border, $w, $h);	1233	1
1139	}	1234	}
1140		1235
1141	sub button_down {	1236	sub invoke_button_down {
1142	my ($self, $ev, $x, $y) = @_;	1237	my ($self, $ev, $x, $y) = @_;
1143		1238
1144	my ($w, $h) = @$self{qw(w h)};	1239	my ($w, $h) = @$self{qw(w h)};
1145	my $border = $self->border;	1240	my $border = $self->border;
1146		1241
…		…
1177		1272
1178	($x, $y) = ($ev->{x}, $ev->{y});	1273	($x, $y) = ($ev->{x}, $ev->{y});
1179		1274
1180	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1275	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1181	# HACK: the next line is required to enforce placement	1276	# HACK: the next line is required to enforce placement
1182	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1277	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1183	};	1278	};
1184	} else {	1279	} else {
1185	return 0;	1280	return 0;
1186	}	1281	}
1187		1282
1188	1	1283	1
1189	}	1284	}
1190		1285
1191	sub button_up {	1286	sub invoke_button_up {
1192	my ($self, $ev, $x, $y) = @_;	1287	my ($self, $ev, $x, $y) = @_;
1193		1288
1194	!!delete $self->{motion}	1289	! ! delete $self->{motion}
1195	}	1290	}
1196		1291
1197	sub mouse_motion {	1292	sub invoke_mouse_motion {
1198	my ($self, $ev, $x, $y) = @_;	1293	my ($self, $ev, $x, $y) = @_;
1199		1294
1200	$self->{motion}->($ev, $x, $y) if $self->{motion};	1295	$self->{motion}->($ev, $x, $y) if $self->{motion};
1201		1296
1202	!!$self->{motion}	1297	! ! $self->{motion}
		1298	}
		1299
		1300	sub invoke_visibility_change {
		1301	my ($self, $visible) = @_;
		1302
		1303	delete $self->{motion} unless $visible;
		1304
		1305	0
1203	}	1306	}
1204		1307
1205	sub _draw {	1308	sub _draw {
1206	my ($self) = @_;	1309	my ($self) = @_;
1207		1310
…		…
1233		1336
1234	glDisable GL_TEXTURE_2D;	1337	glDisable GL_TEXTURE_2D;
1235		1338
1236	$child->draw;	1339	$child->draw;
1237		1340
1238	if ($self->{title}) {	1341	if ($self->{title_widget}) {
1239	glTranslate 0, $border - $self->{h};	1342	glTranslate 0, $border - $self->{h};
1240	$self->{title}->_draw;	1343	$self->{title_widget}->_draw;
		1344
		1345	glTranslate 0, - ($border - $self->{h});
1241	}	1346	}
		1347
		1348	$self->{close_button}->draw
		1349	if $self->{close_button};
1242	}	1350	}
1243		1351
1244	#############################################################################	1352	#############################################################################
1245		1353
1246	package CFClient::UI::Table;	1354	package CFPlus::UI::Table;
1247		1355
1248	our @ISA = CFClient::UI::Base::;	1356	our @ISA = CFPlus::UI::Base::;
1249		1357
1250	use List::Util qw(max sum);	1358	use List::Util qw(max sum);
1251		1359
1252	use CFClient::OpenGL;	1360	use CFPlus::OpenGL;
1253		1361
1254	sub new {	1362	sub new {
1255	my $class = shift;	1363	my $class = shift;
1256		1364
1257	$class->SUPER::new (	1365	$class->SUPER::new (
…		…
1263	sub children {	1371	sub children {
1264	grep $_, map @$_, grep $_, @{ $_[0]{children} }	1372	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1265	}	1373	}
1266		1374
1267	sub add {	1375	sub add {
1268	my ($self, $x, $y, $child) = @_;	1376	my ($self) = shift;
1269		1377
		1378	while (@_) {
		1379	my ($x, $y, $child) = splice @_, 0, 3, ();
1270	$child->set_parent ($self);	1380	$child->set_parent ($self);
1271	$self->{children}[$y][$x] = $child;	1381	$self->{children}[$y][$x] = $child;
		1382	}
1272		1383
		1384	$self->{force_realloc} = 1;
		1385	$self->{force_size_alloc} = 1;
1273	$self->realloc;	1386	$self->realloc;
		1387	}
		1388
		1389	sub remove {
		1390	my ($self, $child) = @_;
		1391
		1392	# TODO: not yet implemented
1274	}	1393	}
1275		1394
1276	# TODO: move to container class maybe? send children a signal on removal?	1395	# TODO: move to container class maybe? send children a signal on removal?
1277	sub clear {	1396	sub clear {
1278	my ($self) = @_;	1397	my ($self) = @_;
…		…
1319	(sum @$ws),	1438	(sum @$ws),
1320	(sum @$hs),	1439	(sum @$hs),
1321	)	1440	)
1322	}	1441	}
1323		1442
1324	sub size_allocate {	1443	sub invoke_size_allocate {
1325	my ($self, $w, $h) = @_;	1444	my ($self, $w, $h) = @_;
1326		1445
1327	my ($ws, $hs) = $self->get_wh;	1446	my ($ws, $hs) = $self->get_wh;
1328		1447
1329	my $req_w = (sum @$ws) || 1;	1448	my $req_w = (sum @$ws) || 1;
…		…
1336		1455
1337	# linearly scale sizes	1456	# linearly scale sizes
1338	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;	1457	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1339	$hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;	1458	$hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1340		1459
1341	CFClient::UI::harmonize $ws;	1460	CFPlus::UI::harmonize $ws;
1342	CFClient::UI::harmonize $hs;	1461	CFPlus::UI::harmonize $hs;
1343		1462
1344	my $y;	1463	my $y;
1345		1464
1346	for my $r (0 .. $#{$self->{children}}) {	1465	for my $r (0 .. $#{$self->{children}}) {
1347	my $row = $self->{children}[$r]	1466	my $row = $self->{children}[$r]
…		…
1361	}	1480	}
1362		1481
1363	$y += $row_h;	1482	$y += $row_h;
1364	}	1483	}
1365		1484
		1485	1
1366	}	1486	}
1367		1487
1368	sub find_widget {	1488	sub find_widget {
1369	my ($self, $x, $y) = @_;	1489	my ($self, $x, $y) = @_;
1370		1490
…		…
1389	}	1509	}
1390	}	1510	}
1391		1511
1392	#############################################################################	1512	#############################################################################
1393		1513
1394	package CFClient::UI::Box;	1514	package CFPlus::UI::Box;
1395		1515
1396	our @ISA = CFClient::UI::Container::;	1516	our @ISA = CFPlus::UI::Container::;
1397		1517
1398	sub size_request {	1518	sub size_request {
1399	my ($self) = @_;	1519	my ($self) = @_;
1400		1520
1401	$self->{vertical}	1521	$self->{vertical}
…		…
1407	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1527	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1408	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1528	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1409	)	1529	)
1410	}	1530	}
1411		1531
1412	sub size_allocate {	1532	sub invoke_size_allocate {
1413	my ($self, $w, $h) = @_;	1533	my ($self, $w, $h) = @_;
1414		1534
1415	my $space = $self->{vertical} ? $h : $w;	1535	my $space = $self->{vertical} ? $h : $w;
1416	my $children = $self->{children};	1536	my @children = $self->visible_children;
1417		1537
1418	my @req;	1538	my @req;
1419		1539
1420	if ($self->{homogeneous}) {	1540	if ($self->{homogeneous}) {
1421	@req = ($space / (@$children || 1)) x @$children;	1541	@req = ($space / (@children || 1)) x @children;
1422	} else {	1542	} else {
1423	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1543	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1424	my $req = List::Util::sum @req;	1544	my $req = List::Util::sum @req;
1425		1545
1426	if ($req > $space) {	1546	if ($req > $space) {
1427	# ah well, not enough space	1547	# ah well, not enough space
1428	$_ *= $space / $req for @req;	1548	$_ *= $space / $req for @req;
1429	} else {	1549	} else {
1430	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1550	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1431		1551
1432	$space = ($space - $req) / $expand; # remaining space to give away	1552	$space = ($space - $req) / $expand; # remaining space to give away
1433		1553
1434	$req[$_] += $space * $children->[$_]{expand}	1554	$req[$_] += $space * $children[$_]{expand}
1435	for 0 .. $#$children;	1555	for 0 .. $#children;
1436	}	1556	}
1437	}	1557	}
1438		1558
1439	CFClient::UI::harmonize \@req;	1559	CFPlus::UI::harmonize \@req;
1440		1560
1441	my $pos = 0;	1561	my $pos = 0;
1442	for (0 .. $#$children) {	1562	for (0 .. $#children) {
1443	my $alloc = $req[$_];	1563	my $alloc = $req[$_];
1444	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1564	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1445		1565
1446	$pos += $alloc;	1566	$pos += $alloc;
1447	}	1567	}
1448		1568
1449	1	1569	1
1450	}	1570	}
1451		1571
1452	#############################################################################	1572	#############################################################################
1453		1573
1454	package CFClient::UI::HBox;	1574	package CFPlus::UI::HBox;
1455		1575
1456	our @ISA = CFClient::UI::Box::;	1576	our @ISA = CFPlus::UI::Box::;
1457		1577
1458	sub new {	1578	sub new {
1459	my $class = shift;	1579	my $class = shift;
1460		1580
1461	$class->SUPER::new (	1581	$class->SUPER::new (
…		…
1464	)	1584	)
1465	}	1585	}
1466		1586
1467	#############################################################################	1587	#############################################################################
1468		1588
1469	package CFClient::UI::VBox;	1589	package CFPlus::UI::VBox;
1470		1590
1471	our @ISA = CFClient::UI::Box::;	1591	our @ISA = CFPlus::UI::Box::;
1472		1592
1473	sub new {	1593	sub new {
1474	my $class = shift;	1594	my $class = shift;
1475		1595
1476	$class->SUPER::new (	1596	$class->SUPER::new (
…		…
1479	)	1599	)
1480	}	1600	}
1481		1601
1482	#############################################################################	1602	#############################################################################
1483		1603
1484	package CFClient::UI::Label;	1604	package CFPlus::UI::Label;
1485		1605
1486	our @ISA = CFClient::UI::DrawBG::;	1606	our @ISA = CFPlus::UI::DrawBG::;
1487		1607
1488	use CFClient::OpenGL;	1608	use CFPlus::OpenGL;
1489		1609
1490	sub new {	1610	sub new {
1491	my ($class, %arg) = @_;	1611	my ($class, %arg) = @_;
1492		1612
1493	my $self = $class->SUPER::new (	1613	my $self = $class->SUPER::new (
…		…
1496	#active_bg => none	1616	#active_bg => none
1497	#font => default_font	1617	#font => default_font
1498	#text => initial text	1618	#text => initial text
1499	#markup => initial narkup	1619	#markup => initial narkup
1500	#max_w => maximum pixel width	1620	#max_w => maximum pixel width
		1621	#style => 0, # render flags
1501	ellipsise => 3, # end	1622	ellipsise => 3, # end
1502	layout => (new CFClient::Layout),	1623	layout => (new CFPlus::Layout),
1503	fontsize => 1,	1624	fontsize => 1,
1504	align => -1,	1625	align => -1,
1505	valign => -1,	1626	valign => -1,
1506	padding_x => 2,	1627	padding_x => 2,
1507	padding_y => 2,	1628	padding_y => 2,
1508	can_events => 0,	1629	can_events => 0,
1509	%arg	1630	%arg
1510	);	1631	);
1511		1632
1512	if (exists $self->{template}) {	1633	if (exists $self->{template}) {
1513	my $layout = new CFClient::Layout;	1634	my $layout = new CFPlus::Layout;
1514	$layout->set_text (delete $self->{template});	1635	$layout->set_text (delete $self->{template});
1515	$self->{template} = $layout;	1636	$self->{template} = $layout;
1516	}	1637	}
1517		1638
1518	if (exists $self->{markup}) {	1639	if (exists $self->{markup}) {
…		…
1522	}	1643	}
1523		1644
1524	$self	1645	$self
1525	}	1646	}
1526		1647
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 {	1648	sub update {
1538	my ($self) = @_;	1649	my ($self) = @_;
1539		1650
1540	delete $self->{texture};	1651	delete $self->{texture};
1541	$self->SUPER::update;	1652	$self->SUPER::update;
…		…
1552	my ($self, $text) = @_;	1663	my ($self, $text) = @_;
1553		1664
1554	return if $self->{text} eq "T$text";	1665	return if $self->{text} eq "T$text";
1555	$self->{text} = "T$text";	1666	$self->{text} = "T$text";
1556		1667
1557	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1558	$self->{layout}->set_text ($text);	1668	$self->{layout}->set_text ($text);
		1669
1559	delete $self->{req_h};	1670	delete $self->{size_req};
1560
1561	$self->realloc;	1671	$self->realloc;
1562	$self->update;	1672	$self->update;
1563	}	1673	}
1564		1674
1565	sub set_markup {	1675	sub set_markup {
…		…
1568	return if $self->{text} eq "M$markup";	1678	return if $self->{text} eq "M$markup";
1569	$self->{text} = "M$markup";	1679	$self->{text} = "M$markup";
1570		1680
1571	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1681	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1572		1682
1573	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1574	$self->{layout}->set_markup ($markup);	1683	$self->{layout}->set_markup ($markup);
		1684
1575	delete $self->{req_h};	1685	delete $self->{size_req};
1576
1577	$self->realloc;	1686	$self->realloc;
1578	$self->update;	1687	$self->update;
1579	}	1688	}
1580		1689
1581	sub size_request {	1690	sub size_request {
1582	my ($self) = @_;	1691	my ($self) = @_;
1583		1692
1584	if (exists $self->{req_h}) {	1693	$self->{size_req} ||= do {
1585	@$self{qw(req_w req_h)}
1586	} else {
1587	$self->{layout}->set_font ($self->{font}) if $self->{font};	1694	$self->{layout}->set_font ($self->{font}) if $self->{font};
1588	$self->{layout}->set_width ($self->{max_w} || -1);	1695	$self->{layout}->set_width ($self->{max_w} || -1);
1589	$self->{layout}->set_ellipsise ($self->{ellipsise});	1696	$self->{layout}->set_ellipsise ($self->{ellipsise});
1590	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1697	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1591	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1698	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1592		1699
1593	my ($w, $h) = $self->{layout}->size;	1700	my ($w, $h) = $self->{layout}->size;
1594		1701
1595	if (exists $self->{template}) {	1702	if (exists $self->{template}) {
1596	$self->{template}->set_font ($self->{font}) if $self->{font};	1703	$self->{template}->set_font ($self->{font}) if $self->{font};
		1704	$self->{template}->set_width ($self->{max_w} || -1);
1597	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1705	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1598		1706
1599	my ($w2, $h2) = $self->{template}->size;	1707	my ($w2, $h2) = $self->{template}->size;
1600		1708
1601	$w = List::Util::max $w, $w2;	1709	$w = List::Util::max $w, $w2;
1602	$h = List::Util::max $h, $h2;	1710	$h = List::Util::max $h, $h2;
1603	}	1711	}
1604		1712
1605	($w, $h)	1713	[$w, $h]
1606	}	1714	};
1607	}
1608		1715
		1716	@{ $self->{size_req} }
		1717	}
		1718
		1719	sub baseline_shift {
		1720	$_[0]{layout}->descent
		1721	}
		1722
1609	sub size_allocate {	1723	sub invoke_size_allocate {
1610	my ($self, $w, $h) = @_;	1724	my ($self, $w, $h) = @_;
1611		1725
1612	delete $self->{ox};	1726	delete $self->{ox};
1613		1727
1614	delete $self->{texture}	1728	delete $self->{texture}
1615	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};	1729	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1730
		1731	1
1616	}	1732	}
1617		1733
1618	sub set_fontsize {	1734	sub set_fontsize {
1619	my ($self, $fontsize) = @_;	1735	my ($self, $fontsize) = @_;
1620		1736
1621	$self->{fontsize} = $fontsize;	1737	$self->{fontsize} = $fontsize;
		1738	delete $self->{size_req};
1622	delete $self->{texture};	1739	delete $self->{texture};
1623		1740
1624	$self->realloc;	1741	$self->realloc;
1625	}	1742	}
1626		1743
		1744	sub reconfigure {
		1745	my ($self) = @_;
		1746
		1747	delete $self->{size_req};
		1748	delete $self->{texture};
		1749
		1750	$self->SUPER::reconfigure;
		1751	}
		1752
1627	sub _draw {	1753	sub _draw {
1628	my ($self) = @_;	1754	my ($self) = @_;
1629		1755
1630	$self->SUPER::_draw; # draw background, if applicable	1756	$self->SUPER::_draw; # draw background, if applicable
1631		1757
1632	my $tex = $self->{texture} ||= do {	1758	my $size = $self->{texture} ||= do {
1633	$self->{layout}->set_foreground (@{$self->{fg}});	1759	$self->{layout}->set_foreground (@{$self->{fg}});
1634	$self->{layout}->set_font ($self->{font}) if $self->{font};	1760	$self->{layout}->set_font ($self->{font}) if $self->{font};
1635	$self->{layout}->set_width ($self->{w});	1761	$self->{layout}->set_width ($self->{w});
1636	$self->{layout}->set_ellipsise ($self->{ellipsise});	1762	$self->{layout}->set_ellipsise ($self->{ellipsise});
1637	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1763	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1638	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1764	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1639		1765
1640	new_from_layout CFClient::Texture $self->{layout}	1766	[$self->{layout}->size]
1641	};	1767	};
1642		1768
1643	unless (exists $self->{ox}) {	1769	unless (exists $self->{ox}) {
1644	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1770	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1645	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1771	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1646	: ($self->{w} - $tex->{w}) * 0.5);	1772	: ($self->{w} - $size->[0]) * 0.5);
1647		1773
1648	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1774	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1649	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1775	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1650	: ($self->{h} - $tex->{h}) * 0.5);	1776	: ($self->{h} - $size->[1]) * 0.5);
1651	};	1777	};
1652		1778
1653	glEnable GL_TEXTURE_2D;	1779	my $w = List::Util::min $self->{w} + 4, $size->[0];
		1780	my $h = List::Util::min $self->{h} + 2, $size->[1];
1654		1781
1655	if ($tex->{format} == GL_ALPHA) {	1782	$self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1656	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1657	glColor @{$self->{fg}};
1658	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1659	} else {
1660	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1661	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1662	}
1663
1664	glDisable GL_TEXTURE_2D;
1665	}	1783	}
1666		1784
1667	#############################################################################	1785	#############################################################################
1668		1786
1669	package CFClient::UI::EntryBase;	1787	package CFPlus::UI::EntryBase;
1670		1788
1671	our @ISA = CFClient::UI::Label::;	1789	our @ISA = CFPlus::UI::Label::;
1672		1790
1673	use CFClient::OpenGL;	1791	use CFPlus::OpenGL;
1674		1792
1675	sub new {	1793	sub new {
1676	my $class = shift;	1794	my $class = shift;
1677		1795
1678	$class->SUPER::new (	1796	$class->SUPER::new (
…		…
1683	can_hover => 1,	1801	can_hover => 1,
1684	can_focus => 1,	1802	can_focus => 1,
1685	valign => 0,	1803	valign => 0,
1686	can_events => 1,	1804	can_events => 1,
1687	#text => ...	1805	#text => ...
		1806	#hidden => "*",
1688	@_	1807	@_
1689	)	1808	)
1690	}	1809	}
1691		1810
1692	sub _set_text {	1811	sub _set_text {
…		…
1699	$self->{last_activity} = $::NOW;	1818	$self->{last_activity} = $::NOW;
1700	$self->{text} = $text;	1819	$self->{text} = $text;
1701		1820
1702	$text =~ s/./*/g if $self->{hidden};	1821	$text =~ s/./*/g if $self->{hidden};
1703	$self->{layout}->set_text ("$text ");	1822	$self->{layout}->set_text ("$text ");
1704	delete $self->{req_h};	1823	delete $self->{size_req};
1705		1824
1706	$self->_emit (changed => $self->{text});	1825	$self->emit (changed => $self->{text});
1707		1826
1708	$self->realloc;	1827	$self->realloc;
1709	$self->update;	1828	$self->update;
1710	}	1829	}
1711		1830
…		…
1726	my ($w, $h) = $self->SUPER::size_request;	1845	my ($w, $h) = $self->SUPER::size_request;
1727		1846
1728	($w + 1, $h) # add 1 for cursor	1847	($w + 1, $h) # add 1 for cursor
1729	}	1848	}
1730		1849
1731	sub key_down {	1850	sub invoke_key_down {
1732	my ($self, $ev) = @_;	1851	my ($self, $ev) = @_;
1733		1852
1734	my $mod = $ev->{mod};	1853	my $mod = $ev->{mod};
1735	my $sym = $ev->{sym};	1854	my $sym = $ev->{sym};
1736	my $uni = $ev->{unicode};	1855	my $uni = $ev->{unicode};
…		…
1739		1858
1740	if ($uni == 8) {	1859	if ($uni == 8) {
1741	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1860	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1742	} elsif ($uni == 127) {	1861	} elsif ($uni == 127) {
1743	substr $text, $self->{cursor}, 1, "";	1862	substr $text, $self->{cursor}, 1, "";
1744	} elsif ($sym == CFClient::SDLK_LEFT) {	1863	} elsif ($sym == CFPlus::SDLK_LEFT) {
1745	--$self->{cursor} if $self->{cursor};	1864	--$self->{cursor} if $self->{cursor};
1746	} elsif ($sym == CFClient::SDLK_RIGHT) {	1865	} elsif ($sym == CFPlus::SDLK_RIGHT) {
1747	++$self->{cursor} if $self->{cursor} < length $self->{text};	1866	++$self->{cursor} if $self->{cursor} < length $self->{text};
1748	} elsif ($sym == CFClient::SDLK_HOME) {	1867	} elsif ($sym == CFPlus::SDLK_HOME) {
1749	$self->{cursor} = 0;	1868	$self->{cursor} = 0;
1750	} elsif ($sym == CFClient::SDLK_END) {	1869	} elsif ($sym == CFPlus::SDLK_END) {
1751	$self->{cursor} = length $text;	1870	$self->{cursor} = length $text;
1752	} elsif ($uni == 27) {	1871	} elsif ($uni == 27) {
1753	$self->_emit ('escape');	1872	$self->emit ('escape');
1754	} elsif ($uni) {	1873	} elsif ($uni) {
1755	substr $text, $self->{cursor}++, 0, chr $uni;	1874	substr $text, $self->{cursor}++, 0, chr $uni;
1756	} else {	1875	} else {
1757	return 0;	1876	return 0;
1758	}	1877	}
…		…
1762	$self->realloc;	1881	$self->realloc;
1763		1882
1764	1	1883	1
1765	}	1884	}
1766		1885
1767	sub focus_in {	1886	sub invoke_focus_in {
1768	my ($self) = @_;	1887	my ($self) = @_;
1769		1888
1770	$self->{last_activity} = $::NOW;	1889	$self->{last_activity} = $::NOW;
1771		1890
1772	$self->SUPER::focus_in;	1891	$self->SUPER::invoke_focus_in
1773	}	1892	}
1774		1893
1775	sub button_down {	1894	sub invoke_button_down {
1776	my ($self, $ev, $x, $y) = @_;	1895	my ($self, $ev, $x, $y) = @_;
1777		1896
1778	$self->SUPER::button_down ($ev, $x, $y);	1897	$self->SUPER::invoke_button_down ($ev, $x, $y);
1779		1898
1780	my $idx = $self->{layout}->xy_to_index ($x, $y);	1899	my $idx = $self->{layout}->xy_to_index ($x, $y);
1781		1900
1782	# byte-index to char-index	1901	# byte-index to char-index
1783	my $text = $self->{text};	1902	my $text = $self->{text};
1784	utf8::encode $text;	1903	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1785	$self->{cursor} = length substr $text, 0, $idx;	1904	$self->{cursor} = length $text;
1786		1905
1787	$self->_set_text ($self->{text});	1906	$self->_set_text ($self->{text});
1788	$self->update;	1907	$self->update;
1789		1908
1790	1	1909	1
1791	}	1910	}
1792		1911
1793	sub mouse_motion {	1912	sub invoke_mouse_motion {
1794	my ($self, $ev, $x, $y) = @_;	1913	my ($self, $ev, $x, $y) = @_;
1795	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1914	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1796		1915
1797	0	1916	1
1798	}	1917	}
1799		1918
1800	sub _draw {	1919	sub _draw {
1801	my ($self) = @_;	1920	my ($self) = @_;
1802		1921
…		…
1829	utf8::encode $text;	1948	utf8::encode $text;
1830		1949
1831	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)	1950	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1832	}	1951	}
1833		1952
1834	glColor @{$self->{fg}};
1835	glBegin GL_LINES;	1953	glBegin GL_LINES;
1836	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};	1954	glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
1837	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};	1955	glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1838	glEnd;	1956	glEnd;
1839	}	1957	}
1840	}	1958	}
1841		1959
1842	package CFClient::UI::Entry;	1960	package CFPlus::UI::Entry;
1843		1961
1844	our @ISA = CFClient::UI::EntryBase::;	1962	our @ISA = CFPlus::UI::EntryBase::;
1845		1963
1846	use CFClient::OpenGL;	1964	use CFPlus::OpenGL;
1847		1965
1848	sub key_down {	1966	sub invoke_key_down {
1849	my ($self, $ev) = @_;	1967	my ($self, $ev) = @_;
1850		1968
1851	my $sym = $ev->{sym};	1969	my $sym = $ev->{sym};
1852		1970
1853	if ($sym == 13) {	1971	if ($sym == 13) {
1854	unshift @{$self->{history}},	1972	unshift @{$self->{history}},
1855	my $txt = $self->get_text;	1973	my $txt = $self->get_text;
		1974
1856	$self->{history_pointer} = -1;	1975	$self->{history_pointer} = -1;
1857	$self->{history_saveback} = '';	1976	$self->{history_saveback} = '';
1858	$self->_emit (activate => $txt);	1977	$self->emit (activate => $txt);
1859	$self->update;	1978	$self->update;
1860		1979
1861	} elsif ($sym == CFClient::SDLK_UP) {	1980	} elsif ($sym == CFPlus::SDLK_UP) {
1862	if ($self->{history_pointer} < 0) {	1981	if ($self->{history_pointer} < 0) {
1863	$self->{history_saveback} = $self->get_text;	1982	$self->{history_saveback} = $self->get_text;
1864	}	1983	}
1865	if (@{$self->{history} || []} > 0) {	1984	if (@{$self->{history} || []} > 0) {
1866	$self->{history_pointer}++;	1985	$self->{history_pointer}++;
…		…
1868	$self->{history_pointer} = @{$self->{history} || []} - 1;	1987	$self->{history_pointer} = @{$self->{history} || []} - 1;
1869	}	1988	}
1870	$self->set_text ($self->{history}->[$self->{history_pointer}]);	1989	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1871	}	1990	}
1872		1991
1873	} elsif ($sym == CFClient::SDLK_DOWN) {	1992	} elsif ($sym == CFPlus::SDLK_DOWN) {
1874	$self->{history_pointer}--;	1993	$self->{history_pointer}--;
1875	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	1994	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1876		1995
1877	if ($self->{history_pointer} >= 0) {	1996	if ($self->{history_pointer} >= 0) {
1878	$self->set_text ($self->{history}->[$self->{history_pointer}]);	1997	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1879	} else {	1998	} else {
1880	$self->set_text ($self->{history_saveback});	1999	$self->set_text ($self->{history_saveback});
1881	}	2000	}
1882		2001
1883	} else {	2002	} else {
1884	return $self->SUPER::key_down ($ev)	2003	return $self->SUPER::invoke_key_down ($ev)
1885	}	2004	}
1886		2005
1887	1	2006	1
1888	}	2007	}
1889		2008
1890	#############################################################################	2009	#############################################################################
1891		2010
1892	package CFClient::UI::Button;	2011	package CFPlus::UI::Button;
1893		2012
1894	our @ISA = CFClient::UI::Label::;	2013	our @ISA = CFPlus::UI::Label::;
1895		2014
1896	use CFClient::OpenGL;	2015	use CFPlus::OpenGL;
1897		2016
1898	my @tex =	2017	my @tex =
1899	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2018	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1900	qw(b1_button_active.png);	2019	qw(b1_button_active.png);
1901		2020
1902	sub new {	2021	sub new {
1903	my $class = shift;	2022	my $class = shift;
1904		2023
…		…
1913	can_events => 1,	2032	can_events => 1,
1914	@_	2033	@_
1915	)	2034	)
1916	}	2035	}
1917		2036
1918	sub activate { }
1919
1920	sub button_up {	2037	sub invoke_button_up {
1921	my ($self, $ev, $x, $y) = @_;	2038	my ($self, $ev, $x, $y) = @_;
1922		2039
1923	$self->emit ("activate")	2040	$self->emit ("activate")
1924	if $x >= 0 && $x < $self->{w}	2041	if $x >= 0 && $x < $self->{w}
1925	&& $y >= 0 && $y < $self->{h};	2042	&& $y >= 0 && $y < $self->{h};
…		…
1943	$self->SUPER::_draw;	2060	$self->SUPER::_draw;
1944	}	2061	}
1945		2062
1946	#############################################################################	2063	#############################################################################
1947		2064
1948	package CFClient::UI::CheckBox;	2065	package CFPlus::UI::CheckBox;
1949		2066
1950	our @ISA = CFClient::UI::DrawBG::;	2067	our @ISA = CFPlus::UI::DrawBG::;
1951		2068
1952	my @tex =	2069	my @tex =
1953	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2070	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1954	qw(c1_checkbox_bg.png c1_checkbox_active.png);	2071	qw(c1_checkbox_bg.png c1_checkbox_active.png);
1955		2072
1956	use CFClient::OpenGL;	2073	use CFPlus::OpenGL;
1957		2074
1958	sub new {	2075	sub new {
1959	my $class = shift;	2076	my $class = shift;
1960		2077
1961	$class->SUPER::new (	2078	$class->SUPER::new (
…		…
1975	my ($self) = @_;	2092	my ($self) = @_;
1976		2093
1977	(6) x 2	2094	(6) x 2
1978	}	2095	}
1979		2096
		2097	sub toggle {
		2098	my ($self) = @_;
		2099
		2100	$self->{state} = !$self->{state};
		2101	$self->emit (changed => $self->{state});
		2102	$self->update;
		2103	}
		2104
1980	sub button_down {	2105	sub invoke_button_down {
1981	my ($self, $ev, $x, $y) = @_;	2106	my ($self, $ev, $x, $y) = @_;
1982		2107
1983	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2108	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1984	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2109	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1985	$self->{state} = !$self->{state};	2110	$self->toggle;
1986	$self->_emit (changed => $self->{state});
1987	} else {	2111	} else {
1988	return 0	2112	return 0
1989	}	2113	}
1990		2114
1991	1	2115	1
…		…
2011	glDisable GL_TEXTURE_2D;	2135	glDisable GL_TEXTURE_2D;
2012	}	2136	}
2013		2137
2014	#############################################################################	2138	#############################################################################
2015		2139
2016	package CFClient::UI::Image;	2140	package CFPlus::UI::Image;
2017		2141
2018	our @ISA = CFClient::UI::Base::;	2142	our @ISA = CFPlus::UI::Base::;
2019		2143
2020	use CFClient::OpenGL;	2144	use CFPlus::OpenGL;
2021	use Carp qw/confess/;
2022		2145
2023	our %loaded_images;	2146	our %texture_cache;
2024		2147
2025	sub new {	2148	sub new {
2026	my $class = shift;	2149	my $class = shift;
2027		2150
2028	my $self = $class->SUPER::new (can_events => 0, @_);	2151	my $self = $class->SUPER::new (
		2152	can_events => 0,
		2153	@_,
		2154	);
2029		2155
2030	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2156	$self->{path} || $self->{tex}
		2157	or Carp::croak "'path' or 'tex' attributes required";
2031		2158
2032	$loaded_images{$self->{image}} ||=	2159	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2033	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2160	new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
2034		2161
2035	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2162	Scalar::Util::weaken $texture_cache{$self->{path}};
2036		2163
2037	Scalar::Util::weaken $loaded_images{$self->{image}};	2164	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2038
2039	$self->{aspect} = $tex->{w} / $tex->{h};
2040		2165
2041	$self	2166	$self
2042	}	2167	}
2043		2168
		2169	sub STORABLE_freeze {
		2170	my ($self, $cloning) = @_;
		2171
		2172	$self->{path}
		2173	or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
		2174
		2175	$self->{path}
		2176	}
		2177
		2178	sub STORABLE_attach {
		2179	my ($self, $cloning, $path) = @_;
		2180
		2181	$self->new (path => $path)
		2182	}
		2183
2044	sub size_request {	2184	sub size_request {
2045	my ($self) = @_;	2185	my ($self) = @_;
2046		2186
2047	($self->{tex}->{w}, $self->{tex}->{h})	2187	($self->{tex}{w}, $self->{tex}{h})
2048	}	2188	}
2049		2189
2050	sub _draw {	2190	sub _draw {
2051	my ($self) = @_;	2191	my ($self) = @_;
2052		2192
…		…
2062	}	2202	}
2063		2203
2064	glEnable GL_TEXTURE_2D;	2204	glEnable GL_TEXTURE_2D;
2065	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2205	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2066		2206
2067	$tex->draw_quad_alpha (0, 0, $w, $h);	2207	$tex->draw_quad (0, 0, $w, $h);
2068		2208
2069	glDisable GL_TEXTURE_2D;	2209	glDisable GL_TEXTURE_2D;
2070	}	2210	}
2071		2211
2072	#############################################################################	2212	#############################################################################
2073		2213
		2214	package CFPlus::UI::ImageButton;
		2215
		2216	our @ISA = CFPlus::UI::Image::;
		2217
		2218	use CFPlus::OpenGL;
		2219
		2220	my %textures;
		2221
		2222	sub new {
		2223	my $class = shift;
		2224
		2225	my $self = $class->SUPER::new (
		2226	padding_x => 4,
		2227	padding_y => 4,
		2228	fg => [1, 1, 1],
		2229	active_fg => [0, 0, 1],
		2230	can_hover => 1,
		2231	align => 0,
		2232	valign => 0,
		2233	can_events => 1,
		2234	@_
		2235	);
		2236	}
		2237
		2238	sub invoke_button_up {
		2239	my ($self, $ev, $x, $y) = @_;
		2240
		2241	$self->emit ("activate")
		2242	if $x >= 0 && $x < $self->{w}
		2243	&& $y >= 0 && $y < $self->{h};
		2244
		2245	1
		2246	}
		2247
		2248	#############################################################################
		2249
2074	package CFClient::UI::VGauge;	2250	package CFPlus::UI::VGauge;
2075		2251
2076	our @ISA = CFClient::UI::Base::;	2252	our @ISA = CFPlus::UI::Base::;
2077		2253
2078	use List::Util qw(min max);	2254	use List::Util qw(min max);
2079		2255
2080	use CFClient::OpenGL;	2256	use CFPlus::OpenGL;
2081		2257
2082	my %tex = (	2258	my %tex = (
2083	food => [	2259	food => [
2084	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2260	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2085	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2261	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2086	],	2262	],
2087	grace => [	2263	grace => [
2088	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2264	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2089	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/	2265	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2090	],	2266	],
2091	hp => [	2267	hp => [
2092	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2268	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2093	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2269	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2094	],	2270	],
2095	mana => [	2271	mana => [
2096	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2272	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2097	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/	2273	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2098	],	2274	],
2099	);	2275	);
2100		2276
2101	# eg. VGauge->new (gauge => 'food'), default gauge: food	2277	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2161	my $ycut1 = max 0, min 1, $ycut;	2337	my $ycut1 = max 0, min 1, $ycut;
2162	my $ycut2 = max 0, min 1, $ycut - 1;	2338	my $ycut2 = max 0, min 1, $ycut - 1;
2163		2339
2164	my $h1 = $self->{h} * (1 - $ycut1);	2340	my $h1 = $self->{h} * (1 - $ycut1);
2165	my $h2 = $self->{h} * (1 - $ycut2);	2341	my $h2 = $self->{h} * (1 - $ycut2);
		2342	my $h3 = $self->{h};
		2343
		2344	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2166		2345
2167	glEnable GL_BLEND;	2346	glEnable GL_BLEND;
2168	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2347	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2169	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2348	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2170	glEnable GL_TEXTURE_2D;	2349	glEnable GL_TEXTURE_2D;
…		…
2189		2368
2190	if ($t3) {	2369	if ($t3) {
2191	glBindTexture GL_TEXTURE_2D, $t3->{name};	2370	glBindTexture GL_TEXTURE_2D, $t3->{name};
2192	glBegin GL_QUADS;	2371	glBegin GL_QUADS;
2193	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2372	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2194	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2373	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2195	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2374	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2196	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2375	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2197	glEnd;	2376	glEnd;
2198	}	2377	}
2199		2378
2200	glDisable GL_BLEND;	2379	glDisable GL_BLEND;
2201	glDisable GL_TEXTURE_2D;	2380	glDisable GL_TEXTURE_2D;
2202	}	2381	}
2203		2382
2204	#############################################################################	2383	#############################################################################
2205		2384
2206	package CFClient::UI::Gauge;	2385	package CFPlus::UI::Gauge;
2207		2386
2208	our @ISA = CFClient::UI::VBox::;	2387	our @ISA = CFPlus::UI::VBox::;
2209		2388
2210	sub new {	2389	sub new {
2211	my ($class, %arg) = @_;	2390	my ($class, %arg) = @_;
2212		2391
2213	my $self = $class->SUPER::new (	2392	my $self = $class->SUPER::new (
…		…
2215	can_hover => 1,	2394	can_hover => 1,
2216	can_events => 1,	2395	can_events => 1,
2217	%arg,	2396	%arg,
2218	);	2397	);
2219		2398
2220	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2399	$self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999");
2221	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);	2400	$self->add ($self->{gauge} = new CFPlus::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
2222	$self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999");	2401	$self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2223		2402
2224	$self	2403	$self
2225	}	2404	}
2226		2405
2227	sub set_fontsize {	2406	sub set_fontsize {
…		…
2248	$self->{value}->set_text ($val);	2427	$self->{value}->set_text ($val);
2249	}	2428	}
2250		2429
2251	#############################################################################	2430	#############################################################################
2252		2431
2253	package CFClient::UI::Slider;	2432	package CFPlus::UI::Slider;
2254		2433
2255	use strict;	2434	use strict;
2256		2435
2257	use CFClient::OpenGL;	2436	use CFPlus::OpenGL;
2258		2437
2259	our @ISA = CFClient::UI::DrawBG::;	2438	our @ISA = CFPlus::UI::DrawBG::;
2260		2439
2261	my @tex =	2440	my @tex =
2262	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	2441	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2263	qw(s1_slider.png s1_slider_bg.png);	2442	qw(s1_slider.png s1_slider_bg.png);
2264		2443
2265	sub new {	2444	sub new {
2266	my $class = shift;	2445	my $class = shift;
2267		2446
…		…
2288	$self->update;	2467	$self->update;
2289		2468
2290	$self	2469	$self
2291	}	2470	}
2292		2471
2293	sub changed { }
2294
2295	sub set_range {	2472	sub set_range {
2296	my ($self, $range) = @_;	2473	my ($self, $range) = @_;
2297		2474
2298	($range, $self->{range}) = ($self->{range}, $range);	2475	($range, $self->{range}) = ($self->{range}, $range);
2299		2476
2300	$self->update
2301	if "@$range" ne "@{$self->{range}}";	2477	if ("@$range" ne "@{$self->{range}}") {
		2478	$self->update;
		2479	$self->set_value ($self->{range}[0]);
		2480	}
2302	}	2481	}
2303		2482
2304	sub set_value {	2483	sub set_value {
2305	my ($self, $value) = @_;	2484	my ($self, $value) = @_;
2306		2485
…		…
2317	if $unit;	2496	if $unit;
2318		2497
2319	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2498	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2320		2499
2321	if ($value != $old_value) {	2500	if ($value != $old_value) {
2322	$self->_emit (changed => $value);	2501	$self->emit (changed => $value);
2323	$self->update;	2502	$self->update;
2324	}	2503	}
2325	}	2504	}
2326		2505
2327	sub size_request {	2506	sub size_request {
2328	my ($self) = @_;	2507	my ($self) = @_;
2329		2508
2330	($self->{req_w}, $self->{req_h})	2509	($self->{req_w}, $self->{req_h})
2331	}	2510	}
2332		2511
2333	sub button_down {	2512	sub invoke_button_down {
2334	my ($self, $ev, $x, $y) = @_;	2513	my ($self, $ev, $x, $y) = @_;
2335		2514
2336	$self->SUPER::button_down ($ev, $x, $y);	2515	$self->SUPER::invoke_button_down ($ev, $x, $y);
2337		2516
2338	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2517	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2339		2518
2340	$self->mouse_motion ($ev, $x, $y)	2519	$self->invoke_mouse_motion ($ev, $x, $y)
2341	}	2520	}
2342		2521
2343	sub mouse_motion {	2522	sub invoke_mouse_motion {
2344	my ($self, $ev, $x, $y) = @_;	2523	my ($self, $ev, $x, $y) = @_;
2345		2524
2346	if ($GRAB == $self) {	2525	if ($GRAB == $self) {
2347	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2526	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2348		2527
…		…
2354	} else {	2533	} else {
2355	return 0;	2534	return 0;
2356	}	2535	}
2357		2536
2358	1	2537	1
		2538	}
		2539
		2540	sub invoke_mouse_wheel {
		2541	my ($self, $ev) = @_;
		2542
		2543	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2544
		2545	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.2);
		2546
		2547	! ! $delta
2359	}	2548	}
2360		2549
2361	sub update {	2550	sub update {
2362	my ($self) = @_;	2551	my ($self) = @_;
2363		2552
…		…
2412	glDisable GL_TEXTURE_2D;	2601	glDisable GL_TEXTURE_2D;
2413	}	2602	}
2414		2603
2415	#############################################################################	2604	#############################################################################
2416		2605
2417	package CFClient::UI::ValSlider;	2606	package CFPlus::UI::ValSlider;
2418		2607
2419	our @ISA = CFClient::UI::HBox::;	2608	our @ISA = CFPlus::UI::HBox::;
2420		2609
2421	sub new {	2610	sub new {
2422	my ($class, %arg) = @_;	2611	my ($class, %arg) = @_;
2423		2612
2424	my $range = delete $arg{range};	2613	my $range = delete $arg{range};
2425		2614
2426	my $self = $class->SUPER::new (	2615	my $self = $class->SUPER::new (
2427	slider => (new CFClient::UI::Slider expand => 1, range => $range),	2616	slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2428	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	2617	entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2429	to_value => sub { shift },	2618	to_value => sub { shift },
2430	from_value => sub { shift },	2619	from_value => sub { shift },
2431	%arg,	2620	%arg,
2432	);	2621	);
2433		2622
…		…
2453	sub set_range { shift->{slider}->set_range (@_) }	2642	sub set_range { shift->{slider}->set_range (@_) }
2454	sub set_value { shift->{slider}->set_value (@_) }	2643	sub set_value { shift->{slider}->set_value (@_) }
2455		2644
2456	#############################################################################	2645	#############################################################################
2457		2646
2458	package CFClient::UI::TextView;	2647	package CFPlus::UI::TextScroller;
2459		2648
2460	our @ISA = CFClient::UI::HBox::;	2649	our @ISA = CFPlus::UI::HBox::;
2461		2650
2462	use CFClient::OpenGL;	2651	use CFPlus::OpenGL;
2463		2652
2464	sub new {	2653	sub new {
2465	my $class = shift;	2654	my $class = shift;
2466		2655
2467	my $self = $class->SUPER::new (	2656	my $self = $class->SUPER::new (
2468	fontsize => 1,	2657	fontsize => 1,
2469	can_events => 0,	2658	can_events => 1,
		2659	indent => 0,
2470	#font => default_font	2660	#font => default_font
2471	@_,	2661	@_,
2472		2662
2473	layout => (new CFClient::Layout 1),	2663	layout => (new CFPlus::Layout),
2474	par => [],	2664	par => [],
2475	height => 0,	2665	height => 0,
2476	children => [	2666	children => [
2477	(new CFClient::UI::Empty expand => 1),	2667	(new CFPlus::UI::Empty expand => 1),
2478	(new CFClient::UI::Slider vertical => 1),	2668	(new CFPlus::UI::Slider vertical => 1),
2479	],	2669	],
2480	);	2670	);
2481		2671
2482	$self->{children}[1]->connect (changed => sub { $self->update });	2672	$self->{children}[1]->connect (changed => sub { $self->update });
2483		2673
…		…
2489		2679
2490	$self->{fontsize} = $fontsize;	2680	$self->{fontsize} = $fontsize;
2491	$self->reflow;	2681	$self->reflow;
2492	}	2682	}
2493		2683
		2684	sub size_request {
		2685	my ($self) = @_;
		2686
		2687	my ($empty, $slider) = @{ $self->{children} };
		2688
		2689	local $self->{children} = [$empty, $slider];
		2690	$self->SUPER::size_request
		2691	}
		2692
2494	sub size_allocate {	2693	sub invoke_size_allocate {
2495	my ($self, $w, $h) = @_;	2694	my ($self, $w, $h) = @_;
2496		2695
2497	$self->SUPER::size_allocate ($w, $h);	2696	my ($empty, $slider, @other) = @{ $self->{children} };
		2697	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2498		2698
2499	$self->{layout}->set_font ($self->{font}) if $self->{font};	2699	$self->{layout}->set_font ($self->{font}) if $self->{font};
2500	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2700	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2501	$self->{layout}->set_width ($self->{children}[0]{w});	2701	$self->{layout}->set_width ($empty->{w});
		2702	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2502		2703
2503	$self->reflow;	2704	$self->reflow;
2504	}
2505		2705
2506	sub text_size {	2706	local $self->{children} = [$empty, $slider];
		2707	$self->SUPER::invoke_size_allocate ($w, $h)
		2708	}
		2709
		2710	sub invoke_mouse_wheel {
2507	my ($self, $text, $indent) = @_;	2711	my ($self, $ev) = @_;
		2712
		2713	return 0 unless $ev->{dy}; # only vertical movements
		2714
		2715	$self->{children}[1]->emit (mouse_wheel => $ev);
		2716
		2717	1
		2718	}
		2719
		2720	sub get_layout {
		2721	my ($self, $para) = @_;
2508		2722
2509	my $layout = $self->{layout};	2723	my $layout = $self->{layout};
2510		2724
		2725	$layout->set_font ($self->{font}) if $self->{font};
		2726	$layout->set_foreground (@{$para->{fg}});
2511	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2727	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2512	$layout->set_width ($self->{children}[0]{w} - $indent);	2728	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
		2729	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2513	$layout->set_markup ($text);	2730	$layout->set_markup ($para->{markup});
		2731
		2732	$layout->set_shapes (
		2733	map
		2734	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		2735	@{$para->{widget}}
2514		2736	);
		2737
2515	$layout->size	2738	$layout
2516	}	2739	}
2517		2740
2518	sub reflow {	2741	sub reflow {
2519	my ($self) = @_;	2742	my ($self) = @_;
2520		2743
…		…
2527		2750
2528	# todo: base offset on lines or so, not on pixels	2751	# todo: base offset on lines or so, not on pixels
2529	$self->{children}[1]->set_value ($offset);	2752	$self->{children}[1]->set_value ($offset);
2530	}	2753	}
2531		2754
		2755	sub current_paragraph {
		2756	my ($self) = @_;
		2757
		2758	$self->force_uptodate;
		2759	$self->{top_paragraph} - 1
		2760	}
		2761
		2762	sub scroll_to {
		2763	my ($self, $para) = @_;
		2764
		2765	$self->force_uptodate;
		2766
		2767	$para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
		2768
		2769	$self->{children}[1]->set_value ($self->{par}[$para]{y});
		2770	}
		2771
2532	sub clear {	2772	sub clear {
2533	my ($self) = @_;	2773	my ($self) = @_;
		2774
		2775	my (undef, undef, @other) = @{ $self->{children} };
		2776	$self->remove ($_) for @other;
2534		2777
2535	$self->{par} = [];	2778	$self->{par} = [];
2536	$self->{height} = 0;	2779	$self->{height} = 0;
2537	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2780	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2538	}	2781	}
2539		2782
2540	sub add_paragraph {	2783	sub add_paragraph {
2541	my ($self, $color, $text, $indent) = @_;	2784	my $self = shift;
2542		2785
2543	for my $line (split /\n/, $text) {	2786	for my $para (@_) {
2544	my ($w, $h) = $self->text_size ($line);	2787	$para = {
		2788	fg => [1, 1, 1, 1],
		2789	indent => 0,
		2790	markup => "",
		2791	widget => [],
		2792	ref $para ? %$para : (markup => $para),
		2793	w => 1e10,
		2794	wrapped => 1,
		2795	};
		2796
		2797	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		2798	push @{$self->{par}}, $para;
		2799	}
		2800
		2801	$self->{need_reflow}++;
		2802	$self->update;
		2803	}
		2804
		2805	sub scroll_to_bottom {
		2806	my ($self) = @_;
		2807
		2808	$self->{scroll_to_bottom} = 1;
		2809	$self->update;
		2810	}
		2811
		2812	sub force_uptodate {
		2813	my ($self) = @_;
		2814
		2815	if (delete $self->{need_reflow}) {
		2816	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2817
		2818	my $height = 0;
		2819	my $paridx;
		2820	my $top_paragraph;
		2821	my $top = int $self->{children}[1]{range}[0];
		2822
		2823	for my $para (@{$self->{par}}) {
		2824	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		2825	my $layout = $self->get_layout ($para);
		2826	my ($w, $h) = $layout->size;
		2827
		2828	$para->{w} = $w + $para->{indent};
		2829	$para->{h} = $h;
		2830	$para->{wrapped} = $layout->has_wrapped;
		2831	}
		2832
		2833	$para->{y} = $height;
		2834
		2835	$paridx++;
		2836	$top_paragraph ||= $paridx if $height >= $top;
		2837
		2838	$height += $para->{h};
		2839	}
		2840
		2841	$self->{top_paragraph} = $top_paragraph;
2545	$self->{height} += $h;	2842	$self->{height} = $height;
2546	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2547	}
2548		2843
2549	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	2844	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
		2845
		2846	delete $self->{texture};
		2847	}
		2848
		2849	if (delete $self->{scroll_to_bottom}) {
		2850	$self->{children}[1]->set_value (1e10);
		2851	}
2550	}	2852	}
2551		2853
2552	sub update {	2854	sub update {
2553	my ($self) = @_;	2855	my ($self) = @_;
2554		2856
…		…
2556		2858
2557	return unless $self->{h} > 0;	2859	return unless $self->{h} > 0;
2558		2860
2559	delete $self->{texture};	2861	delete $self->{texture};
2560		2862
2561	$ROOT->on_post_alloc ($self, sub {	2863	$ROOT->on_post_alloc ($self => sub {
		2864	$self->force_uptodate;
		2865
2562	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2866	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2563		2867
2564	if (delete $self->{need_reflow}) {
2565	my $height = 0;
2566
2567	my $layout = $self->{layout};
2568
2569	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2570
2571	for (@{$self->{par}}) {
2572	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2573	$layout->set_width ($W - $_->[3]);
2574	$layout->set_markup ($_->[4]);
2575	my ($w, $h) = $layout->size;
2576	$_->[0] = $w + $_->[3];
2577	$_->[1] = $h;
2578	}
2579
2580	$height += $_->[1];
2581	}
2582
2583	$self->{height} = $height;
2584
2585	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2586
2587	delete $self->{texture};
2588	}
2589
2590	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2868	$self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2591	glClearColor 0, 0, 0, 0;	2869	glClearColor 0, 0, 0, 0;
2592	glClear GL_COLOR_BUFFER_BIT;	2870	glClear GL_COLOR_BUFFER_BIT;
2593		2871
2594	my $top = int $self->{children}[1]{range}[0];	2872	my $top = int $self->{children}[1]{range}[0];
2595		2873
2596	my $y0 = $top;	2874	my $y0 = $top;
2597	my $y1 = $top + $H;	2875	my $y1 = $top + $H;
2598		2876
2599	my $y = 0;
2600
2601	my $layout = $self->{layout};
2602
2603	$layout->set_font ($self->{font}) if $self->{font};
2604
2605	glEnable GL_BLEND;
2606	#TODO# not correct in windows where rgba is forced off
2607	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2608
2609	for my $par (@{$self->{par}}) {	2877	for my $para (@{$self->{par}}) {
2610	my $h = $par->[1];	2878	my $h = $para->{h};
		2879	my $y = $para->{y};
2611		2880
2612	if ($y0 < $y + $h && $y < $y1) {	2881	if ($y0 < $y + $h && $y < $y1) {
2613	$layout->set_foreground (@{ $par->[2] });	2882	my $layout = $self->get_layout ($para);
2614	$layout->set_width ($W - $par->[3]);
2615	$layout->set_markup ($par->[4]);
2616		2883
2617	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2884	$layout->render ($para->{indent}, $y - $y0);
2618		2885
2619	glRasterPos $par->[3], $y - $y0;	2886	if (my @w = @{ $para->{widget} }) {
2620	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	2887	my @s = $layout->get_shapes;
		2888
		2889	for (@w) {
		2890	my ($dx, $dy) = splice @s, 0, 2, ();
		2891
		2892	$_->{x} = $dx + $para->{indent};
		2893	$_->{y} = $dy + $y - $y0;
		2894
		2895	$_->draw;
		2896	}
		2897	}
2621	}	2898	}
2622
2623	$y += $h;
2624	}	2899	}
2625
2626	glDisable GL_BLEND;
2627	};	2900	};
2628	});	2901	});
		2902	}
		2903
		2904	sub reconfigure {
		2905	my ($self) = @_;
		2906
		2907	$self->SUPER::reconfigure;
		2908
		2909	$_->{w} = 1e10 for @{ $self->{par} };
		2910	$self->reflow;
2629	}	2911	}
2630		2912
2631	sub _draw {	2913	sub _draw {
2632	my ($self) = @_;	2914	my ($self) = @_;
2633		2915
…		…
2636	glColor 0, 0, 0, 1;	2918	glColor 0, 0, 0, 1;
2637	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2919	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2638	glDisable GL_TEXTURE_2D;	2920	glDisable GL_TEXTURE_2D;
2639		2921
2640	$self->{children}[1]->draw;	2922	$self->{children}[1]->draw;
2641
2642	}	2923	}
2643		2924
2644	#############################################################################	2925	#############################################################################
2645		2926
2646	package CFClient::UI::Animator;	2927	package CFPlus::UI::Animator;
2647		2928
2648	use CFClient::OpenGL;	2929	use CFPlus::OpenGL;
2649		2930
2650	our @ISA = CFClient::UI::Bin::;	2931	our @ISA = CFPlus::UI::Bin::;
2651		2932
2652	sub moveto {	2933	sub moveto {
2653	my ($self, $x, $y) = @_;	2934	my ($self, $x, $y) = @_;
2654		2935
2655	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	2936	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2683	glPopMatrix;	2964	glPopMatrix;
2684	}	2965	}
2685		2966
2686	#############################################################################	2967	#############################################################################
2687		2968
2688	package CFClient::UI::Flopper;	2969	package CFPlus::UI::Flopper;
2689		2970
2690	our @ISA = CFClient::UI::Button::;	2971	our @ISA = CFPlus::UI::Button::;
2691		2972
2692	sub new {	2973	sub new {
2693	my $class = shift;	2974	my $class = shift;
2694		2975
2695	my $self = $class->SUPER::new (	2976	my $self = $class->SUPER::new (
…		…
2707	$self->{other}->toggle_visibility;	2988	$self->{other}->toggle_visibility;
2708	}	2989	}
2709		2990
2710	#############################################################################	2991	#############################################################################
2711		2992
2712	package CFClient::UI::Tooltip;	2993	package CFPlus::UI::Tooltip;
2713		2994
2714	our @ISA = CFClient::UI::Bin::;	2995	our @ISA = CFPlus::UI::Bin::;
2715		2996
2716	use CFClient::OpenGL;	2997	use CFPlus::OpenGL;
2717		2998
2718	sub new {	2999	sub new {
2719	my $class = shift;	3000	my $class = shift;
2720		3001
2721	$class->SUPER::new (	3002	$class->SUPER::new (
…		…
2724	)	3005	)
2725	}	3006	}
2726		3007
2727	sub set_tooltip_from {	3008	sub set_tooltip_from {
2728	my ($self, $widget) = @_;	3009	my ($self, $widget) = @_;
		3010
		3011	$widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
		3012	if $widget->{tooltip} =~ /^#(.*)$/;
2729		3013
2730	my $tooltip = $widget->{tooltip};	3014	my $tooltip = $widget->{tooltip};
2731		3015
2732	if ($ENV{CFPLUS_DEBUG} & 2) {	3016	if ($ENV{CFPLUS_DEBUG} & 2) {
2733	$tooltip .= "\n\n" . (ref $widget) . "\n"	3017	$tooltip .= "\n\n" . (ref $widget) . "\n"
2734	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	3018	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2735	. "req $widget->{req_w} $widget->{req_h}\n"	3019	. "req $widget->{req_w} $widget->{req_h}\n"
2736	. "visible $widget->{visible}";	3020	. "visible $widget->{visible}";
2737	}	3021	}
2738		3022
		3023	$tooltip =~ s/^\n+//;
		3024	$tooltip =~ s/\n+$//;
		3025
2739	$self->add (new CFClient::UI::Label	3026	$self->add (new CFPlus::UI::Label
2740	markup => $tooltip,	3027	markup => $tooltip,
2741	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3028	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2742	fontsize => 0.8,	3029	fontsize => 0.8,
2743	fg => [0, 0, 0, 1],	3030	style => 1, # FLAG_INVERSE
2744	ellipsise => 0,	3031	ellipsise => 0,
2745	font => ($widget->{tooltip_font} || $::FONT_PROP),	3032	font => ($widget->{tooltip_font} || $::FONT_PROP),
2746	);	3033	);
2747	}	3034	}
2748		3035
…		…
2752	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	3039	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2753		3040
2754	($w + 4, $h + 4)	3041	($w + 4, $h + 4)
2755	}	3042	}
2756		3043
2757	sub size_allocate {	3044	sub invoke_size_allocate {
2758	my ($self, $w, $h) = @_;	3045	my ($self, $w, $h) = @_;
2759		3046
2760	$self->SUPER::size_allocate ($w - 4, $h - 4);	3047	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2761	}	3048	}
2762		3049
2763	sub visibility_change {	3050	sub invoke_visibility_change {
2764	my ($self, $visible) = @_;	3051	my ($self, $visible) = @_;
2765		3052
2766	return unless $visible;	3053	return unless $visible;
2767		3054
2768	$self->{root}->on_post_alloc ("move_$self" => sub {	3055	$self->{root}->on_post_alloc ("move_$self" => sub {
2769	my $widget = $self->{owner}	3056	my $widget = $self->{owner}
2770	or return;	3057	or return;
2771		3058
		3059	if ($widget->{visible}) {
2772	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3060	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2773		3061
2774	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3062	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2775	if $x + $self->{w} > $::WIDTH;	3063	if $x + $self->{w} > $self->{root}{w};
2776		3064
2777	$self->move_abs ($x, $y);	3065	$self->move_abs ($x, $y);
		3066	} else {
		3067	$self->hide;
		3068	}
2778	});	3069	});
2779	}	3070	}
2780		3071
2781	sub _draw {	3072	sub _draw {
2782	my ($self) = @_;	3073	my ($self) = @_;
…		…
2806	$self->SUPER::_draw;	3097	$self->SUPER::_draw;
2807	}	3098	}
2808		3099
2809	#############################################################################	3100	#############################################################################
2810		3101
2811	package CFClient::UI::Face;	3102	package CFPlus::UI::Face;
2812		3103
2813	our @ISA = CFClient::UI::Base::;	3104	our @ISA = CFPlus::UI::DrawBG::;
2814		3105
2815	use CFClient::OpenGL;	3106	use CFPlus::OpenGL;
2816		3107
2817	sub new {	3108	sub new {
2818	my $class = shift;	3109	my $class = shift;
2819		3110
2820	my $self = $class->SUPER::new (	3111	my $self = $class->SUPER::new (
…		…
2855	sub _draw {	3146	sub _draw {
2856	my ($self) = @_;	3147	my ($self) = @_;
2857		3148
2858	return unless $::CONN;	3149	return unless $::CONN;
2859		3150
		3151	$self->SUPER::_draw;
		3152
2860	my $face;	3153	my $face;
2861		3154
2862	if ($self->{frame}) {	3155	if ($self->{frame}) {
2863	my $anim = $::CONN->{anim}[$self->{anim}];	3156	my $anim = $::CONN->{anim}[$self->{anim}];
2864		3157
…		…
2875	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3168	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2876	glDisable GL_TEXTURE_2D;	3169	glDisable GL_TEXTURE_2D;
2877	}	3170	}
2878	}	3171	}
2879		3172
2880	sub DESTROY {	3173	sub destroy {
2881	my ($self) = @_;	3174	my ($self) = @_;
2882		3175
2883	$self->{timer}->cancel	3176	$self->{timer}->cancel
2884	if $self->{timer};	3177	if $self->{timer};
2885		3178
2886	$self->SUPER::DESTROY;	3179	$self->SUPER::destroy;
2887	}	3180	}
2888		3181
2889	#############################################################################	3182	#############################################################################
2890		3183
2891	package CFClient::UI::Buttonbar;	3184	package CFPlus::UI::Buttonbar;
2892		3185
2893	our @ISA = CFClient::UI::HBox::;	3186	our @ISA = CFPlus::UI::HBox::;
2894		3187
2895	# TODO: should actualyl wrap buttons and other goodies.	3188	# TODO: should actualyl wrap buttons and other goodies.
2896		3189
2897	#############################################################################	3190	#############################################################################
2898		3191
2899	package CFClient::UI::Menu;	3192	package CFPlus::UI::Menu;
2900		3193
2901	our @ISA = CFClient::UI::FancyFrame::;	3194	our @ISA = CFPlus::UI::FancyFrame::;
2902		3195
2903	use CFClient::OpenGL;	3196	use CFPlus::OpenGL;
2904		3197
2905	sub new {	3198	sub new {
2906	my $class = shift;	3199	my $class = shift;
2907		3200
2908	my $self = $class->SUPER::new (	3201	my $self = $class->SUPER::new (
2909	items => [],	3202	items => [],
2910	z => 100,	3203	z => 100,
2911	@_,	3204	@_,
2912	);	3205	);
2913		3206
2914	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3207	$self->add ($self->{vbox} = new CFPlus::UI::VBox);
2915		3208
2916	for my $item (@{ $self->{items} }) {	3209	for my $item (@{ $self->{items} }) {
2917	my ($widget, $cb) = @$item;	3210	my ($widget, $cb, $tooltip) = @$item;
2918		3211
2919	# handle various types of items, only text for now	3212	# handle various types of items, only text for now
2920	if (!ref $widget) {	3213	if (!ref $widget) {
		3214	if ($widget =~ /\t/) {
		3215	my ($left, $right) = split /\t/, $widget, 2;
		3216
2921	$widget = new CFClient::UI::Label	3217	$widget = new CFPlus::UI::HBox
2922	can_hover => 1,	3218	can_hover => 1,
2923	can_events => 1,	3219	can_events => 1,
		3220	tooltip => $tooltip,
		3221	children => [
		3222	(new CFPlus::UI::Label markup => $left, expand => 1),
		3223	(new CFPlus::UI::Label markup => $right, align => +1),
		3224	],
		3225	;
		3226
		3227	} else {
		3228	$widget = new CFPlus::UI::Label
		3229	can_hover => 1,
		3230	can_events => 1,
2924	text => $widget;	3231	markup => $widget,
		3232	tooltip => $tooltip;
		3233	}
2925	}	3234	}
2926		3235
2927	$self->{item}{$widget} = $item;	3236	$self->{item}{$widget} = $item;
2928		3237
2929	$self->{vbox}->add ($widget);	3238	$self->{vbox}->add ($widget);
…		…
2934		3243
2935	# popup given the event (must be a mouse button down event currently)	3244	# popup given the event (must be a mouse button down event currently)
2936	sub popup {	3245	sub popup {
2937	my ($self, $ev) = @_;	3246	my ($self, $ev) = @_;
2938		3247
2939	$self->_emit ("popdown");	3248	$self->emit ("popdown");
2940		3249
2941	# maybe save $GRAB? must be careful about events...	3250	# maybe save $GRAB? must be careful about events...
2942	$GRAB = $self;	3251	$GRAB = $self;
2943	$self->{button} = $ev->{button};	3252	$self->{button} = $ev->{button};
2944		3253
2945	$self->show;	3254	$self->show;
2946	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3255	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2947	}	3256	}
2948		3257
2949	sub mouse_motion {	3258	sub invoke_mouse_motion {
2950	my ($self, $ev, $x, $y) = @_;	3259	my ($self, $ev, $x, $y) = @_;
2951		3260
2952	# TODO: should use vbox->find_widget or so	3261	# TODO: should use vbox->find_widget or so
2953	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3262	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2954	$self->{hover} = $self->{item}{$HOVER};	3263	$self->{hover} = $self->{item}{$HOVER};
2955		3264
2956	0	3265	0
2957	}	3266	}
2958		3267
2959	sub button_up {	3268	sub invoke_button_up {
2960	my ($self, $ev, $x, $y) = @_;	3269	my ($self, $ev, $x, $y) = @_;
2961		3270
2962	if ($ev->{button} == $self->{button}) {	3271	if ($ev->{button} == $self->{button}) {
2963	undef $GRAB;	3272	undef $GRAB;
2964	$self->hide;	3273	$self->hide;
2965		3274
2966	$self->_emit ("popdown");	3275	$self->emit ("popdown");
2967	$self->{hover}[1]->() if $self->{hover};	3276	$self->{hover}[1]->() if $self->{hover};
2968	} else {	3277	} else {
2969	return 0	3278	return 0
2970	}	3279	}
2971		3280
2972	1	3281	1
2973	}	3282	}
2974		3283
2975	#############################################################################	3284	#############################################################################
2976		3285
2977	package CFClient::UI::Multiplexer;	3286	package CFPlus::UI::Multiplexer;
2978		3287
2979	our @ISA = CFClient::UI::Container::;	3288	our @ISA = CFPlus::UI::Container::;
2980		3289
2981	sub new {	3290	sub new {
2982	my $class = shift;	3291	my $class = shift;
2983		3292
2984	my $self = $class->SUPER::new (	3293	my $self = $class->SUPER::new (
…		…
2998		3307
2999	$self->{current} = $self->{children}[0]	3308	$self->{current} = $self->{children}[0]
3000	if @{ $self->{children} };	3309	if @{ $self->{children} };
3001	}	3310	}
3002		3311
		3312	sub get_current_page {
		3313	my ($self) = @_;
		3314
		3315	$self->{current}
		3316	}
		3317
3003	sub set_current_page {	3318	sub set_current_page {
3004	my ($self, $page_or_widget) = @_;	3319	my ($self, $page_or_widget) = @_;
3005		3320
3006	my $widget = ref $page_or_widget	3321	my $widget = ref $page_or_widget
3007	? $page_or_widget	3322	? $page_or_widget
3008	: $self->{children}[$page_or_widget];	3323	: $self->{children}[$page_or_widget];
3009		3324
3010	$self->{current} = $widget;	3325	$self->{current} = $widget;
3011	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3326	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3012		3327
3013	$self->_emit (page_changed => $self->{current});	3328	$self->emit (page_changed => $self->{current});
3014		3329
3015	$self->realloc;	3330	$self->realloc;
3016	}	3331	}
3017		3332
3018	sub visible_children {	3333	sub visible_children {
…		…
3023	my ($self) = @_;	3338	my ($self) = @_;
3024		3339
3025	$self->{current}->size_request	3340	$self->{current}->size_request
3026	}	3341	}
3027		3342
3028	sub size_allocate {	3343	sub invoke_size_allocate {
3029	my ($self, $w, $h) = @_;	3344	my ($self, $w, $h) = @_;
3030		3345
3031	$self->{current}->configure (0, 0, $w, $h);	3346	$self->{current}->configure (0, 0, $w, $h);
		3347
		3348	1
3032	}	3349	}
3033		3350
3034	sub _draw {	3351	sub _draw {
3035	my ($self) = @_;	3352	my ($self) = @_;
3036		3353
3037	$self->{current}->draw;	3354	$self->{current}->draw;
3038	}	3355	}
3039		3356
3040	#############################################################################	3357	#############################################################################
3041		3358
3042	package CFClient::UI::Notebook;	3359	package CFPlus::UI::Notebook;
3043		3360
3044	our @ISA = CFClient::UI::VBox::;	3361	our @ISA = CFPlus::UI::VBox::;
3045		3362
3046	sub new {	3363	sub new {
3047	my $class = shift;	3364	my $class = shift;
3048		3365
3049	my $self = $class->SUPER::new (	3366	my $self = $class->SUPER::new (
3050	buttonbar => (new CFClient::UI::Buttonbar),	3367	buttonbar => (new CFPlus::UI::Buttonbar),
3051	multiplexer => (new CFClient::UI::Multiplexer expand => 1),	3368	multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
3052	# filter => # will be put between multiplexer and $self	3369	# filter => # will be put between multiplexer and $self
3053	@_,	3370	@_,
3054	);	3371	);
3055		3372
3056	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};	3373	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
…		…
3062	sub add {	3379	sub add {
3063	my ($self, $title, $widget, $tooltip) = @_;	3380	my ($self, $title, $widget, $tooltip) = @_;
3064		3381
3065	Scalar::Util::weaken $self;	3382	Scalar::Util::weaken $self;
3066		3383
3067	$self->{buttonbar}->add (new CFClient::UI::Button	3384	$self->{buttonbar}->add (new CFPlus::UI::Button
3068	markup => $title,	3385	markup => $title,
3069	tooltip => $tooltip,	3386	tooltip => $tooltip,
3070	on_activate => sub { $self->set_current_page ($widget) },	3387	on_activate => sub { $self->set_current_page ($widget) },
3071	);	3388	);
3072		3389
3073	$self->{multiplexer}->add ($widget);	3390	$self->{multiplexer}->add ($widget);
3074	}	3391	}
3075		3392
		3393	sub get_current_page {
		3394	my ($self) = @_;
		3395
		3396	$self->{multiplexer}->get_current_page
		3397	}
		3398
3076	sub set_current_page {	3399	sub set_current_page {
3077	my ($self, $page) = @_;	3400	my ($self, $page) = @_;
3078		3401
3079	$self->{multiplexer}->set_current_page ($page);	3402	$self->{multiplexer}->set_current_page ($page);
3080	$self->_emit (page_changed => $self->{multiplexer}{current});	3403	$self->emit (page_changed => $self->{multiplexer}{current});
3081	}	3404	}
3082		3405
3083	#############################################################################	3406	#############################################################################
3084		3407
		3408	package CFPlus::UI::Selector;
		3409
		3410	use utf8;
		3411
		3412	our @ISA = CFPlus::UI::Button::;
		3413
		3414	sub new {
		3415	my $class = shift;
		3416
		3417	my $self = $class->SUPER::new (
		3418	options => [], # [value, title, longdesc], ...
		3419	value => undef,
		3420	@_,
		3421	);
		3422
		3423	$self->_set_value ($self->{value});
		3424
		3425	$self
		3426	}
		3427
		3428	sub invoke_button_down {
		3429	my ($self, $ev) = @_;
		3430
		3431	my @menu_items;
		3432
		3433	for (@{ $self->{options} }) {
		3434	my ($value, $title, $tooltip) = @$_;
		3435
		3436	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3437	}
		3438
		3439	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3440	}
		3441
		3442	sub _set_value {
		3443	my ($self, $value) = @_;
		3444
		3445	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3446	or return;
		3447
		3448	$self->{value} = $item->[0];
		3449	$self->set_markup ("$item->[1] ⇓");
		3450	$self->set_tooltip ($item->[2]);
		3451	}
		3452
		3453	sub set_value {
		3454	my ($self, $value) = @_;
		3455
		3456	return unless $self->{value} ne $value;
		3457
		3458	$self->_set_value ($value);
		3459	$self->emit (changed => $value);
		3460	}
		3461
		3462	#############################################################################
		3463
3085	package CFClient::UI::Statusbox;	3464	package CFPlus::UI::Statusbox;
3086		3465
3087	our @ISA = CFClient::UI::VBox::;	3466	our @ISA = CFPlus::UI::VBox::;
3088		3467
3089	sub new {	3468	sub new {
3090	my $class = shift;	3469	my $class = shift;
3091		3470
3092	my $self = $class->SUPER::new (	3471	my $self = $class->SUPER::new (
…		…
3104	sub reorder {	3483	sub reorder {
3105	my ($self) = @_;	3484	my ($self) = @_;
3106	my $NOW = Time::HiRes::time;	3485	my $NOW = Time::HiRes::time;
3107		3486
3108	# freeze display when hovering over any label	3487	# freeze display when hovering over any label
3109	return if $CFClient::UI::TOOLTIP->{owner}	3488	return if $CFPlus::UI::TOOLTIP->{owner}
3110	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},	3489	&& grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
3111	values %{ $self->{item} };	3490	values %{ $self->{item} };
3112		3491
3113	while (my ($k, $v) = each %{ $self->{item} }) {	3492	while (my ($k, $v) = each %{ $self->{item} }) {
3114	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3493	delete $self->{item}{$k} if $v->{timeout} < $NOW;
3115	}	3494	}
…		…
3136	for ($short) {	3515	for ($short) {
3137	s/^\s+//;	3516	s/^\s+//;
3138	s/\s+/ /g;	3517	s/\s+/ /g;
3139	}	3518	}
3140		3519
3141	new CFClient::UI::Label	3520	new CFPlus::UI::Label
3142	markup => $short,	3521	markup => $short,
3143	tooltip => $item->{tooltip},	3522	tooltip => $item->{tooltip},
3144	tooltip_font => $::FONT_PROP,	3523	tooltip_font => $::FONT_PROP,
3145	tooltip_width => 0.67,	3524	tooltip_width => 0.67,
3146	fontsize => $item->{fontsize} || $self->{fontsize},	3525	fontsize => $item->{fontsize} || $self->{fontsize},
…		…
3184	$item->{count}++;	3563	$item->{count}++;
3185	} else {	3564	} else {
3186	$item->{count} = 1;	3565	$item->{count} = 1;
3187	$item->{text} = $item->{tooltip} = $text;	3566	$item->{text} = $item->{tooltip} = $text;
3188	}	3567	}
3189	$item->{id} = ++$self->{id};	3568	$item->{id} += 0.2;#d#
3190	$item->{timeout} = $timeout;	3569	$item->{timeout} = $timeout;
3191	delete $item->{label};	3570	delete $item->{label};
3192	} else {	3571	} else {
3193	$self->{item}{$group} = {	3572	$self->{item}{$group} = {
3194	id => ++$self->{id},	3573	id => ++$self->{id},
…		…
3200	count => 1,	3579	count => 1,
3201	%arg,	3580	%arg,
3202	};	3581	};
3203	}	3582	}
3204		3583
		3584	$ROOT->on_refresh (reorder => sub {
3205	$self->reorder;	3585	$self->reorder;
		3586	});
3206	}	3587	}
3207		3588
3208	sub reconfigure {	3589	sub reconfigure {
3209	my ($self) = @_;	3590	my ($self) = @_;
3210		3591
…		…
3213		3594
3214	$self->reorder;	3595	$self->reorder;
3215	$self->SUPER::reconfigure;	3596	$self->SUPER::reconfigure;
3216	}	3597	}
3217		3598
3218	sub DESTROY {	3599	sub destroy {
3219	my ($self) = @_;	3600	my ($self) = @_;
3220		3601
3221	$self->{timer}->cancel;	3602	$self->{timer}->cancel;
3222		3603
3223	$self->SUPER::DESTROY;	3604	$self->SUPER::destroy;
3224	}	3605	}
3225		3606
3226	#############################################################################	3607	#############################################################################
3227		3608
3228	package CFClient::UI::Inventory;	3609	package CFPlus::UI::Inventory;
3229		3610
3230	our @ISA = CFClient::UI::ScrolledWindow::;	3611	our @ISA = CFPlus::UI::Table::;
3231		3612
3232	sub new {	3613	sub new {
3233	my $class = shift;	3614	my $class = shift;
3234		3615
3235	my $self = $class->SUPER::new (	3616	my $self = $class->SUPER::new (
3236	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),	3617	col_expand => [0, 1, 0],
		3618	items => [],
3237	@_,	3619	@_,
3238	);	3620	);
3239		3621
		3622	$self->set_sort_order (undef);
		3623
3240	$self	3624	$self
		3625	}
		3626
		3627	sub update_items {
		3628	my ($self) = @_;
		3629
		3630	$self->clear;
		3631
		3632	my @item = $self->{sort}->(@{ $self->{items} });
		3633
		3634	my @adds;
		3635	my $row = 0;
		3636	for my $item ($self->{sort}->(@{ $self->{items} })) {
		3637	CFPlus::Item::update_widgets $item;
		3638
		3639	push @adds, 0, $row, $item->{face_widget};
		3640	push @adds, 1, $row, $item->{desc_widget};
		3641	push @adds, 2, $row, $item->{weight_widget};
		3642
		3643	$row++;
		3644	}
		3645
		3646	$self->add (@adds);
		3647	}
		3648
		3649	sub set_sort_order {
		3650	my ($self, $order) = @_;
		3651
		3652	$self->{sort} = $order ||= sub {
		3653	sort {
		3654	$a->{type} <=> $b->{type}
		3655	or $a->{name} cmp $b->{name}
		3656	} @_
		3657	};
		3658
		3659	$self->update_items;
3241	}	3660	}
3242		3661
3243	sub set_items {	3662	sub set_items {
3244	my ($self, $items) = @_;	3663	my ($self, $items) = @_;
3245		3664
3246	$self->{child}->clear;	3665	$self->{items} = [$items ? values %$items : ()];
3247	return unless $items;	3666	$self->update_items;
3248
3249	my @items = sort {
3250	($a->{type} <=> $b->{type})
3251	or ($a->{name} cmp $b->{name})
3252	} @$items;
3253
3254	$self->{real_items} = \@items;
3255
3256	my $row = 0;
3257	for my $item (@items) {
3258	CFClient::Item::update_widgets $item;
3259
3260	$self->{child}->add (0, $row, $item->{face_widget});
3261	$self->{child}->add (1, $row, $item->{desc_widget});
3262	$self->{child}->add (2, $row, $item->{weight_widget});
3263
3264	$row++;
3265	}
3266	}	3667	}
3267		3668
3268	#############################################################################	3669	#############################################################################
3269		3670
3270	package CFClient::UI::BindEditor;
3271
3272	our @ISA = CFClient::UI::FancyFrame::;
3273
3274	sub new {
3275	my $class = shift;
3276
3277	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3278
3279	$self->add (my $vb = new CFClient::UI::VBox);
3280
3281
3282	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3283	text => "start recording",
3284	tooltip => "Start/Stops recording of actions."
3285	."All subsequent actions after the recording started will be captured."
3286	."The actions are displayed after the record was stopped."
3287	."To bind the action you have to click on the 'Bind' button",
3288	on_activate => sub {
3289	unless ($self->{recording}) {
3290	$self->start;
3291	} else {
3292	$self->stop;
3293	}
3294	});
3295
3296	$vb->add (new CFClient::UI::Label text => "Actions:");
3297	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3298
3299	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3300	$vb->add (my $hb = new CFClient::UI::HBox);
3301	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3302	$hb->add (new CFClient::UI::Button
3303	text => "bind",
3304	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3305	on_activate => sub {
3306	$self->ask_for_bind;
3307	});
3308
3309	$vb->add (my $hb = new CFClient::UI::HBox);
3310	$hb->add (new CFClient::UI::Button
3311	text => "ok",
3312	expand => 1,
3313	tooltip => "This closes the binding editor and saves the binding",
3314	on_activate => sub {
3315	$self->hide;
3316	$self->commit;
3317	});
3318
3319	$hb->add (new CFClient::UI::Button
3320	text => "cancel",
3321	expand => 1,
3322	tooltip => "This closes the binding editor without saving",
3323	on_activate => sub {
3324	$self->hide;
3325	$self->{binding_cancel}->()
3326	if $self->{binding_cancel};
3327	});
3328
3329	$self->update_binding_widgets;
3330
3331	$self
3332	}
3333
3334	sub commit {
3335	my ($self) = @_;
3336	my ($mod, $sym, $cmds) = $self->get_binding;
3337	if ($sym != 0 && @$cmds > 0) {
3338	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3339	."'. Don't forget 'Save Config'!");
3340	$self->{binding_change}->($mod, $sym, $cmds)
3341	if $self->{binding_change};
3342	} else {
3343	$::STATUSBOX->add ("No action bound, no key or action specified!");
3344	$self->{binding_cancel}->()
3345	if $self->{binding_cancel};
3346	}
3347	}
3348
3349	sub start {
3350	my ($self) = @_;
3351
3352	$self->{rec_btn}->set_text ("stop recording");
3353	$self->{recording} = 1;
3354	$self->clear_command_list;
3355	$::CONN->start_record if $::CONN;
3356	}
3357
3358	sub stop {
3359	my ($self) = @_;
3360
3361	$self->{rec_btn}->set_text ("start recording");
3362	$self->{recording} = 0;
3363
3364	my $rec;
3365	$rec = $::CONN->stop_record if $::CONN;
3366	return unless ref $rec eq 'ARRAY';
3367	$self->set_command_list ($rec);
3368	}
3369
3370
3371	sub ask_for_bind_and_commit {
3372	my ($self) = @_;
3373	$self->ask_for_bind (1);
3374	}
3375
3376	sub ask_for_bind {
3377	my ($self, $commit) = @_;
3378
3379	CFClient::Binder::open_binding_dialog (sub {
3380	my ($mod, $sym) = @_;
3381	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3382	$self->update_binding_widgets;
3383	$self->commit if $commit;
3384	});
3385	}
3386
3387	# $mod and $sym are the modifiers and key symbol
3388	# $cmds is a array ref of strings (the commands)
3389	# $cb is the callback that is executed on OK
3390	# $ccb is the callback that is executed on CANCEL and
3391	# when the binding was unsuccessful on OK
3392	sub set_binding {
3393	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3394
3395	$self->clear_command_list;
3396	$self->{recording} = 0;
3397	$self->{rec_btn}->set_text ("start recording");
3398
3399	$self->{binding} = [$mod, $sym];
3400	$self->{commands} = $cmds;
3401
3402	$self->{binding_change} = $cb;
3403	$self->{binding_cancel} = $ccb;
3404
3405	$self->update_binding_widgets;
3406	}
3407
3408	# this is a shortcut method that asks for a binding
3409	# and then just binds it.
3410	sub do_quick_binding {
3411	my ($self, $cmds) = @_;
3412	$self->set_binding (undef, undef, $cmds, sub {
3413	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3414	});
3415	$self->ask_for_bind (1);
3416	}
3417
3418	sub update_binding_widgets {
3419	my ($self) = @_;
3420	my ($mod, $sym, $cmds) = $self->get_binding;
3421	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3422	$self->set_command_list ($cmds);
3423	}
3424
3425	sub get_binding {
3426	my ($self) = @_;
3427	return (
3428	$self->{binding}->[0],
3429	$self->{binding}->[1],
3430	[ grep { defined $_ } @{$self->{commands}} ]
3431	);
3432	}
3433
3434	sub clear_command_list {
3435	my ($self) = @_;
3436	$self->{cmdbox}->clear ();
3437	}
3438
3439	sub set_command_list {
3440	my ($self, $cmds) = @_;
3441
3442	$self->{cmdbox}->clear ();
3443	$self->{commands} = $cmds;
3444
3445	my $idx = 0;
3446
3447	for (@$cmds) {
3448	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3449
3450	my $i = $idx;
3451	$hb->add (new CFClient::UI::Label text => $_);
3452	$hb->add (new CFClient::UI::Button
3453	text => "delete",
3454	tooltip => "Deletes the action from the record",
3455	on_activate => sub {
3456	$self->{cmdbox}->remove ($hb);
3457	$cmds->[$i] = undef;
3458	});
3459
3460
3461	$idx++
3462	}
3463	}
3464
3465	#############################################################################
3466
3467	package CFClient::UI::SpellList;	3671	package CFPlus::UI::SpellList;
3468		3672
3469	our @ISA = CFClient::UI::Table::;	3673	our @ISA = CFPlus::UI::Table::;
3470		3674
3471	sub new {	3675	sub new {
3472	my $class = shift;	3676	my $class = shift;
3473		3677
3474	my $self = $class->SUPER::new (	3678	my $self = $class->SUPER::new (
…		…
3476	commands => [],	3680	commands => [],
3477	@_,	3681	@_,
3478	)	3682	)
3479	}	3683	}
3480		3684
3481	# XXX: Do sorting? Argl...	3685	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3686
		3687	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3688	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3689	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3690	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3691	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3692	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3693	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3694	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3695	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3696	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3697
		3698	sub rebuild_spell_list {
		3699	my ($self) = @_;
		3700
		3701	$CFPlus::UI::ROOT->on_refresh ($self => sub {
		3702	$self->clear;
		3703
		3704	return unless $::CONN;
		3705
		3706	$self->add (1, 0, new CFPlus::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3707	$self->add (2, 0, new CFPlus::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3708	$self->add (3, 0, new CFPlus::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3709	$self->add (4, 0, new CFPlus::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3710	$self->add (5, 0, new CFPlus::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3711
		3712	my $row = 0;
		3713
		3714	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3715	my $spell = $self->{spell}{$_};
		3716
		3717	$row++;
		3718
		3719	my $spell_cb = sub {
		3720	my ($widget, $ev) = @_;
		3721
		3722	if ($ev->{button} == 1) {
		3723	$::CONN->user_send ("cast $spell->{name}");
		3724	} elsif ($ev->{button} == 2) {
		3725	$::CONN->user_send ("invoke $spell->{name}");
		3726	} elsif ($ev->{button} == 3) {
		3727	(new CFPlus::UI::Menu
		3728	items => [
		3729	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3730	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3731	],
		3732	)->popup ($ev);
		3733	} else {
		3734	return 0;
		3735	}
		3736
		3737	1
		3738	};
		3739
		3740	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3741
		3742	#TODO: add path info to tooltip
		3743	#$self->add (6, $row, new CFPlus::UI::Label text => $spell->{path});
		3744
		3745	$self->add (0, $row, new CFPlus::UI::Face
		3746	face => $spell->{face},
		3747	can_hover => 1,
		3748	can_events => 1,
		3749	tooltip => $tooltip,
		3750	on_button_down => $spell_cb,
		3751	);
		3752
		3753	$self->add (1, $row, new CFPlus::UI::Label
		3754	expand => 1,
		3755	text => $spell->{name},
		3756	can_hover => 1,
		3757	can_events => 1,
		3758	tooltip => $tooltip,
		3759	on_button_down => $spell_cb,
		3760	);
		3761
		3762	$self->add (2, $row, new CFPlus::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3763	$self->add (3, $row, new CFPlus::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3764	$self->add (4, $row, new CFPlus::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3765	$self->add (5, $row, new CFPlus::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3766	}
		3767	});
		3768	}
		3769
3482	sub add_spell {	3770	sub add_spell {
3483	my ($self, $spell) = @_;	3771	my ($self, $spell) = @_;
		3772
3484	$self->{spells}->{$spell->{name}} = $spell;	3773	$self->{spell}->{$spell->{name}} = $spell;
3485		3774	$self->rebuild_spell_list;
3486	$self->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3487	face => $spell->{face},
3488	can_hover => 1,
3489	can_events => 1,
3490	tooltip => $spell->{message});
3491
3492	$self->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3493	text => $spell->{name},
3494	can_hover => 1,
3495	can_events => 1,
3496	tooltip => $spell->{message},
3497	expand => 1);
3498
3499	$self->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3500	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3501	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3502	expand => 1);
3503
3504	$self->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3505	text => "bind to key",
3506	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3507	}
3508
3509	sub rebuild_spell_list {
3510	my ($self) = @_;
3511	$self->{tbl_idx} = 0;
3512	$self->add_spell ($_) for values %{$self->{spells}};
3513	}	3775	}
3514		3776
3515	sub remove_spell {	3777	sub remove_spell {
3516	my ($self, $spell) = @_;	3778	my ($self, $spell) = @_;
		3779
3517	delete $self->{spells}->{$spell->{name}};	3780	delete $self->{spell}->{$spell->{name}};
3518	$self->rebuild_spell_list;	3781	$self->rebuild_spell_list;
3519	}	3782	}
3520		3783
		3784	sub clear_spells {
		3785	my ($self) = @_;
		3786
		3787	$self->{spell} = {};
		3788	$self->rebuild_spell_list;
		3789	}
		3790
3521	#############################################################################	3791	#############################################################################
3522		3792
3523	package CFClient::UI::Root;	3793	package CFPlus::UI::Root;
3524		3794
3525	our @ISA = CFClient::UI::Container::;	3795	our @ISA = CFPlus::UI::Container::;
3526		3796
3527	use List::Util qw(min max);	3797	use List::Util qw(min max);
3528		3798
3529	use CFClient::OpenGL;	3799	use CFPlus::OpenGL;
3530		3800
3531	sub new {	3801	sub new {
3532	my $class = shift;	3802	my $class = shift;
3533		3803
3534	my $self = $class->SUPER::new (	3804	my $self = $class->SUPER::new (
…		…
3559	$coord = $max - $size if $coord > $max - $size;	3829	$coord = $max - $size if $coord > $max - $size;
3560		3830
3561	int $coord + 0.5	3831	int $coord + 0.5
3562	}	3832	}
3563		3833
3564	sub size_allocate {	3834	sub invoke_size_allocate {
3565	my ($self, $w, $h) = @_;	3835	my ($self, $w, $h) = @_;
3566		3836
3567	for my $child ($self->children) {	3837	for my $child ($self->children) {
3568	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3838	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3569		3839
…		…
3573	$X = _to_pixel $X, $W, $self->{w};	3843	$X = _to_pixel $X, $W, $self->{w};
3574	$Y = _to_pixel $Y, $H, $self->{h};	3844	$Y = _to_pixel $Y, $H, $self->{h};
3575		3845
3576	$child->configure ($X, $Y, $W, $H);	3846	$child->configure ($X, $Y, $W, $H);
3577	}	3847	}
		3848
		3849	1
3578	}	3850	}
3579		3851
3580	sub coord2local {	3852	sub coord2local {
3581	my ($self, $x, $y) = @_;	3853	my ($self, $x, $y) = @_;
3582		3854
…		…
3708	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3980	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3709		3981
3710	$w = 0 if $w < 0;	3982	$w = 0 if $w < 0;
3711	$h = 0 if $h < 0;	3983	$h = 0 if $h < 0;
3712		3984
		3985	$w = max $widget->{min_w}, $w;
		3986	$h = max $widget->{min_h}, $h;
		3987
		3988	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		3989	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		3990
		3991	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3992	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3993
3713	$w = int $w + 0.5;	3994	$w = int $w + 0.5;
3714	$h = int $h + 0.5;	3995	$h = int $h + 0.5;
3715		3996
3716	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	3997	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3717	$widget->{old_w} = $widget->{w};	3998	$widget->{old_w} = $widget->{w};
…		…
3740	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4021	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3741	glMatrixMode GL_MODELVIEW;	4022	glMatrixMode GL_MODELVIEW;
3742	glLoadIdentity;	4023	glLoadIdentity;
3743		4024
3744	{	4025	{
3745	package CFClient::UI::Base;	4026	package CFPlus::UI::Base;
3746		4027
3747	($draw_x, $draw_y, $draw_w, $draw_h) =	4028	($draw_x, $draw_y, $draw_w, $draw_h) =
3748	(0, 0, $self->{w}, $self->{h});	4029	(0, 0, $self->{w}, $self->{h});
3749	}	4030	}
3750		4031
3751	$self->_draw;	4032	$self->_draw;
3752	}	4033	}
3753		4034
3754	#############################################################################	4035	#############################################################################
3755		4036
3756	package CFClient::UI;	4037	package CFPlus::UI;
3757		4038
3758	$ROOT = new CFClient::UI::Root;	4039	$ROOT = new CFPlus::UI::Root;
3759	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4040	$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
3760		4041
3761	1	4042	1
3762		4043

Diff Legend

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