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

Diff Legend

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