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.298 by root, Wed Jun 7 07:00:30 2006 UTC vs.
Revision 1.339 by root, Sun Jul 30 12:15:19 2006 UTC

…		…
79	sub feed_sdl_key_up_event {	79	sub feed_sdl_key_up_event {
80	$FOCUS->emit (key_up => $_[0])	80	$FOCUS->emit (key_up => $_[0])
81	if $FOCUS;	81	if $FOCUS;
82	}	82	}
83		83
		84	sub check_hover {
		85	my ($widget) = @_;
		86
		87	if ($widget != $HOVER) {
		88	my $hover = $HOVER; $HOVER = $widget;
		89
		90	$hover->update if $hover && $hover->{can_hover};
		91	$HOVER->update if $HOVER && $HOVER->{can_hover};
		92
		93	$TOOLTIP_WATCHER->start;
		94	}
		95	}
		96
84	sub feed_sdl_button_down_event {	97	sub feed_sdl_button_down_event {
85	my ($ev) = @_;	98	my ($ev) = @_;
86	my ($x, $y) = ($ev->{x}, $ev->{y});	99	my ($x, $y) = ($ev->{x}, $ev->{y});
87		100
88	if (!$BUTTON_STATE) {	101	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
		102
		103	unless ($GRAB) {
89	my $widget = $ROOT->find_widget ($x, $y);	104	my $widget = $ROOT->find_widget ($x, $y);
90		105
91	$GRAB = $widget;	106	$GRAB = $widget;
92	$GRAB->update if $GRAB;	107	$GRAB->update if $GRAB;
93		108
94	$TOOLTIP_WATCHER->cb->();	109	$TOOLTIP_WATCHER->cb->();
95	}	110	}
96		111
97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	112	if ($GRAB) {
98		113	if ($ev->{button} == 4 || $ev->{button} == 5) {
99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	114	# mousewheel
100	if $GRAB;	115	$ev->{dx} = 0;
		116	$ev->{dy} = $ev->{button} * 2 - 9;
		117	$GRAB->emit (mouse_wheel => $ev);
		118	} else {
		119	$GRAB->emit (button_down => $ev)
		120	}
		121	}
101	}	122	}
102		123
103	sub feed_sdl_button_up_event {	124	sub feed_sdl_button_up_event {
104	my ($ev) = @_;	125	my ($ev) = @_;
105	my ($x, $y) = ($ev->{x}, $ev->{y});
106		126
107	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	127	my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
108		128
109	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	129	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
110		130
111	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))	131	$GRAB->emit (button_up => $ev)
112	if $GRAB;	132	if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
113		133
114	if (!$BUTTON_STATE) {	134	unless ($BUTTON_STATE) {
115	my $grab = $GRAB; undef $GRAB;	135	my $grab = $GRAB; undef $GRAB;
116	$grab->update if $grab;	136	$grab->update if $grab;
117	$GRAB->update if $GRAB;	137	$GRAB->update if $GRAB;
118		138
		139	check_hover $widget;
119	$TOOLTIP_WATCHER->cb->();	140	$TOOLTIP_WATCHER->cb->();
120	}	141	}
121	}	142	}
122		143
123	sub feed_sdl_motion_event {	144	sub feed_sdl_motion_event {
124	my ($ev) = @_;	145	my ($ev) = @_;
125	my ($x, $y) = ($ev->{x}, $ev->{y});	146	my ($x, $y) = ($ev->{x}, $ev->{y});
126		147
127	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	148	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
128		149
129	if ($widget != $HOVER) {	150	check_hover $widget;
130	my $hover = $HOVER; $HOVER = $widget;
131		151
132	$hover->update if $hover && $hover->{can_hover};	152	$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;	153	if $HOVER;
140	}	154	}
141		155
142	# convert position array to integers	156	# convert position array to integers
143	sub harmonize {	157	sub harmonize {
…		…
189		203
190	}	204	}
191	}	205	}
192		206
193	reconfigure_widgets;	207	reconfigure_widgets;
		208	}
		209
		210	#############################################################################
		211
		212	package CFClient::UI::Event;
		213
		214	sub xy {
		215	$_[1]->coord2local ($_[0]{x}, $_[0]{y})
194	}	216	}
195		217
196	#############################################################################	218	#############################################################################
197		219
198	package CFClient::UI::Base;	220	package CFClient::UI::Base;
…		…
272		294
273	return unless $self->{visible};	295	return unless $self->{visible};
274		296
275	$_->set_invisible for $self->children;	297	$_->set_invisible for $self->children;
276		298
		299	delete $self->{visible};
277	delete $self->{root};	300	delete $self->{root};
278	delete $self->{visible};
279		301
280	undef $GRAB if $GRAB == $self;	302	undef $GRAB if $GRAB == $self;
281	undef $HOVER if $HOVER == $self;	303	undef $HOVER if $HOVER == $self;
282		304
283	$CFClient::UI::TOOLTIP_WATCHER->cb->()	305	$CFClient::UI::TOOLTIP_WATCHER->cb->()
284	if $TOOLTIP->{owner} == $self;	306	if $TOOLTIP->{owner} == $self;
285		307
286	$self->focus_out;	308	$self->emit ("focus_out");
287
288	$self->emit (visibility_change => 0);	309	$self->emit (visibility_change => 0);
289	}	310	}
290		311
291	sub set_visibility {	312	sub set_visibility {
292	my ($self, $visible) = @_;	313	my ($self, $visible) = @_;
…		…
336	sub size_request {	357	sub size_request {
337	require Carp;	358	require Carp;
338	Carp::confess "size_request is abstract";	359	Carp::confess "size_request is abstract";
339	}	360	}
340		361
		362	sub baseline_shift {
		363	0
		364	}
		365
341	sub configure {	366	sub configure {
342	my ($self, $x, $y, $w, $h) = @_;	367	my ($self, $x, $y, $w, $h) = @_;
343		368
344	if ($self->{aspect}) {	369	if ($self->{aspect}) {
345	my ($ow, $oh) = ($w, $h);	370	my ($ow, $oh) = ($w, $h);
346		371
347	$w = List::Util::min $w, int $h * $self->{aspect};	372	$w = List::Util::min $w, CFClient::ceil $h * $self->{aspect};
348	$h = List::Util::min $h, int $w / $self->{aspect};	373	$h = List::Util::min $h, CFClient::ceil $w / $self->{aspect};
349		374
350	# use alignment to adjust x, y	375	# use alignment to adjust x, y
351		376
352	$x += int 0.5 * ($ow - $w);	377	$x += int 0.5 * ($ow - $w);
353	$y += int 0.5 * ($oh - $h);	378	$y += int 0.5 * ($oh - $h);
…		…
367		392
368	$self->{root}{size_alloc}{$self+0} = $self;	393	$self->{root}{size_alloc}{$self+0} = $self;
369	}	394	}
370	}	395	}
371		396
372	sub size_allocate {
373	# nothing to be done
374	}
375
376	sub children {	397	sub children {
377	# nop	398	# nop
378	}	399	}
379		400
380	sub visible_children {	401	sub visible_children {
…		…
408		429
409	# translate global coordinates to local coordinate system	430	# translate global coordinates to local coordinate system
410	sub coord2local {	431	sub coord2local {
411	my ($self, $x, $y) = @_;	432	my ($self, $x, $y) = @_;
412		433
		434	Carp::confess unless $self->{parent};#d#
		435
413	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})	436	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
414	}	437	}
415		438
416	# translate local coordinates to global coordinate system	439	# translate local coordinates to global coordinate system
417	sub coord2global {	440	sub coord2global {
418	my ($self, $x, $y) = @_;	441	my ($self, $x, $y) = @_;
419		442
		443	Carp::confess unless $self->{parent};#d#
		444
420	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	445	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421	}	446	}
422		447
423	sub focus_in {	448	sub invoke_focus_in {
424	my ($self) = @_;	449	my ($self) = @_;
425		450
426	return if $FOCUS == $self;	451	return if $FOCUS == $self;
427	return unless $self->{can_focus};	452	return unless $self->{can_focus};
428		453
429	my $focus = $FOCUS; $FOCUS = $self;	454	$FOCUS = $self;
430		455
431	$self->_emit (focus_in => $focus);	456	$self->update;
432		457
433	$focus->update if $focus;	458	0
434	$FOCUS->update;
435	}	459	}
436		460
437	sub focus_out {	461	sub invoke_focus_out {
438	my ($self) = @_;	462	my ($self) = @_;
439		463
440	return unless $FOCUS == $self;	464	return unless $FOCUS == $self;
441		465
442	my $focus = $FOCUS; undef $FOCUS;	466	undef $FOCUS;
443		467
444	$self->_emit (focus_out => $focus);	468	$self->update;
445		469
446	$focus->update if $focus; #?
447
448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	470	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449	unless $FOCUS;	471	unless $FOCUS;
450	}
451		472
		473	0
		474	}
		475
		476	sub grab_focus {
		477	my ($self) = @_;
		478
		479	$FOCUS->emit ("focus_out") if $FOCUS;
		480	$self->emit ("focus_in");
		481	}
		482
452	sub mouse_motion { 0 }	483	sub invoke_mouse_motion { 0 }
453	sub button_up { 0 }	484	sub invoke_button_up { 0 }
454	sub key_down { 0 }	485	sub invoke_key_down { 0 }
455	sub key_up { 0 }	486	sub invoke_key_up { 0 }
		487	sub invoke_mouse_wheel { 0 }
456		488
457	sub button_down {	489	sub invoke_button_down {
458	my ($self, $ev, $x, $y) = @_;	490	my ($self, $ev, $x, $y) = @_;
459		491
460	$self->focus_in;	492	$self->grab_focus;
461		493
462	0	494	0
		495	}
		496
		497	sub connect {
		498	my ($self, $signal, $cb) = @_;
		499
		500	push @{ $self->{signal_cb}{$signal} }, $cb;
		501
		502	defined wantarray and CFClient::guard {
		503	@{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
		504	@{ $self->{signal_cb}{$signal} };
		505	}
		506	}
		507
		508	my %has_coords = (
		509	button_down => 1,
		510	button_up => 1,
		511	mouse_motion => 1,
		512	mouse_wheel => 1,
		513	);
		514
		515	sub emit {
		516	my ($self, $signal, @args) = @_;
		517
		518	# I do not really like this solution, but I dislike duplication
		519	# and needlessly verbose code, too.
		520	my @append
		521	= $has_coords{$signal}
		522	? $args[0]->xy ($self)
		523	: ();
		524
		525	#warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
		526
		527	#d##TODO# stop propagating at first true, do not use sum
		528	(List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
		529	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append) # closure
		530	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
463	}	531	}
464		532
465	sub find_widget {	533	sub find_widget {
466	my ($self, $x, $y) = @_;	534	my ($self, $x, $y) = @_;
467		535
…		…
477	sub set_parent {	545	sub set_parent {
478	my ($self, $parent) = @_;	546	my ($self, $parent) = @_;
479		547
480	Scalar::Util::weaken ($self->{parent} = $parent);	548	Scalar::Util::weaken ($self->{parent} = $parent);
481	$self->set_visible if $parent->{visible};	549	$self->set_visible if $parent->{visible};
482	}
483
484	sub connect {
485	my ($self, $signal, $cb) = @_;
486
487	push @{ $self->{signal_cb}{$signal} }, $cb;
488	}
489
490	sub _emit {
491	my ($self, $signal, @args) = @_;
492
493	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
494	}
495
496	sub emit {
497	my ($self, $signal, @args) = @_;
498
499	$self->_emit ($signal, @args)
500	|| $self->$signal (@args);
501	}
502
503	sub visibility_change {
504	#my ($self, $visible) = @_;
505	}	550	}
506		551
507	sub realloc {	552	sub realloc {
508	my ($self) = @_;	553	my ($self) = @_;
509		554
…		…
542	return unless $self->{h} && $self->{w};	587	return unless $self->{h} && $self->{w};
543		588
544	# update screen rectangle	589	# update screen rectangle
545	local $draw_x = $draw_x + $self->{x};	590	local $draw_x = $draw_x + $self->{x};
546	local $draw_y = $draw_y + $self->{y};	591	local $draw_y = $draw_y + $self->{y};
547	local $draw_w = $draw_x + $self->{w};
548	local $draw_h = $draw_y + $self->{h};
549		592
550	# skip widgets that are entirely outside the drawing area	593	# skip widgets that are entirely outside the drawing area
551	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)	594	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
552	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);	595	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
553		596
…		…
592	}	635	}
593		636
594	sub DESTROY {	637	sub DESTROY {
595	my ($self) = @_;	638	my ($self) = @_;
596		639
		640	return if CFClient::in_destruct;
		641
597	delete $WIDGET{$self+0};	642	delete $WIDGET{$self+0};
598	#$self->deactivate;	643
		644	eval { $self->destroy };
		645	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
599	}	646	}
600		647
601	#############################################################################	648	#############################################################################
602		649
603	package CFClient::UI::DrawBG;	650	package CFClient::UI::DrawBG;
…		…
684	if $children;	731	if $children;
685		732
686	$self	733	$self
687	}	734	}
688		735
		736	sub realloc {
		737	my ($self) = @_;
		738
		739	$self->{force_realloc} = 1;
		740	$self->{force_size_alloc} = 1;
		741	$self->SUPER::realloc;
		742	}
		743
689	sub add {	744	sub add {
690	my ($self, @widgets) = @_;	745	my ($self, @widgets) = @_;
691		746
692	$_->set_parent ($self)	747	$_->set_parent ($self)
693	for @widgets;	748	for @widgets;
…		…
768	}	823	}
769		824
770	sub add {	825	sub add {
771	my ($self, $child) = @_;	826	my ($self, $child) = @_;
772		827
773	$self->{children} = [];	828	$self->SUPER::remove ($_) for @{ $self->{children} };
774
775	$self->SUPER::add ($child);	829	$self->SUPER::add ($child);
776	}	830	}
777		831
778	sub remove {	832	sub remove {
779	my ($self, $widget) = @_;	833	my ($self, $widget) = @_;
…		…
788		842
789	sub size_request {	843	sub size_request {
790	$_[0]{children}[0]->size_request	844	$_[0]{children}[0]->size_request
791	}	845	}
792		846
793	sub size_allocate {	847	sub invoke_size_allocate {
794	my ($self, $w, $h) = @_;	848	my ($self, $w, $h) = @_;
795		849
796	$self->{children}[0]->configure (0, 0, $w, $h);	850	$self->{children}[0]->configure (0, 0, $w, $h);
		851
		852	1
797	}	853	}
798		854
799	#############################################################################	855	#############################################################################
800		856
801	# back-buffered drawing area	857	# back-buffered drawing area
…		…
817		873
818	$ROOT->on_post_alloc ($self => sub { $self->render_child });	874	$ROOT->on_post_alloc ($self => sub { $self->render_child });
819	$self->SUPER::update;	875	$self->SUPER::update;
820	}	876	}
821		877
822	sub size_allocate {	878	sub invoke_size_allocate {
823	my ($self, $w, $h) = @_;	879	my ($self, $w, $h) = @_;
824		880
825	$self->SUPER::size_allocate ($w, $h);
826	$self->update;	881	$self->update;
		882
		883	$self->SUPER::invoke_size_allocate ($w, $h)
827	}	884	}
828		885
829	sub _render {	886	sub _render {
830	my ($self) = @_;	887	my ($self) = @_;
831		888
…		…
892	$h = 10 if $self->{scroll_y};	949	$h = 10 if $self->{scroll_y};
893		950
894	($w, $h)	951	($w, $h)
895	}	952	}
896		953
897	sub size_allocate {	954	sub invoke_size_allocate {
898	my ($self, $w, $h) = @_;	955	my ($self, $w, $h) = @_;
899		956
900	my $child = $self->child;	957	my $child = $self->child;
901		958
902	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};	959	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
903	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};	960	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
904		961
905	$self->child->configure (0, 0, $w, $h);	962	$self->child->configure (0, 0, $w, $h);
906	$self->update;	963	$self->update;
		964
		965	1
907	}	966	}
908		967
909	sub set_offset {	968	sub set_offset {
910	my ($self, $x, $y) = @_;	969	my ($self, $x, $y) = @_;
911		970
…		…
974	$self->{vp}->set_offset (0, $_[1]);	1033	$self->{vp}->set_offset (0, $_[1]);
975	},	1034	},
976	;	1035	;
977		1036
978	$self = $class->SUPER::new (	1037	$self = $class->SUPER::new (
979	vp => (new CFClient::UI::ViewPort expand => 1),	1038	vp => (new CFClient::UI::ViewPort expand => 1),
		1039	can_events => 1,
980	slider => $slider,	1040	slider => $slider,
981	%arg,	1041	%arg,
982	);	1042	);
983		1043
984	$self->SUPER::add ($self->{vp}, $self->{slider});	1044	$self->SUPER::add ($self->{vp}, $self->{slider});
985	$self->add ($child) if $child;	1045	$self->add ($child) if $child;
986		1046
987	$self	1047	$self
988	}	1048	}
989		1049
		1050	#TODO# update range on size_allocate depending on child
		1051
990	sub add {	1052	sub add {
991	my ($self, $widget) = @_;	1053	my ($self, $widget) = @_;
992		1054
993	$self->{vp}->add ($self->{child} = $widget);	1055	$self->{vp}->add ($self->{child} = $widget);
994	}	1056	}
995		1057
		1058	sub invoke_mouse_wheel {
		1059	my ($self, $ev) = @_;
		1060
		1061	return 0 unless $ev->{dy}; # only vertical movements
		1062
		1063	$self->{slider}->emit (mouse_wheel => $ev);
		1064
		1065	1
		1066	}
		1067
		1068	sub update_slider {
		1069	my ($self) = @_;
		1070
		1071	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
		1072	}
		1073
996	sub update {	1074	sub update {
997	my ($self) = @_;	1075	my ($self) = @_;
998		1076
999	$self->SUPER::update;	1077	$self->SUPER::update;
1000		1078
1001	# todo: overwrite size_allocate of child	1079	$self->update_slider;
1002	my $child = $self->{vp}->child;
1003	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1004	}	1080	}
1005		1081
1006	sub size_allocate {	1082	sub invoke_size_allocate {
1007	my ($self, $w, $h) = @_;	1083	my ($self, $w, $h) = @_;
1008		1084
		1085	$self->update_slider;
		1086
1009	$self->SUPER::size_allocate ($w, $h);	1087	$self->SUPER::invoke_size_allocate ($w, $h)
1010
1011	my $child = $self->{vp}->child;
1012	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1013	}	1088	}
1014
1015	#TODO# update range on size_allocate depending on child
1016	# update viewport offset on scroll
1017		1089
1018	#############################################################################	1090	#############################################################################
1019		1091
1020	package CFClient::UI::Frame;	1092	package CFClient::UI::Frame;
1021		1093
…		…
1072	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1144	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1073		1145
1074	sub new {	1146	sub new {
1075	my ($class, %arg) = @_;	1147	my ($class, %arg) = @_;
1076		1148
1077	my $title = delete $arg{title};
1078
1079	my $self = $class->SUPER::new (	1149	my $self = $class->SUPER::new (
1080	bg => [1, 1, 1, 1],	1150	bg => [1, 1, 1, 1],
1081	border_bg => [1, 1, 1, 1],	1151	border_bg => [1, 1, 1, 1],
1082	border => 0.6,	1152	border => 0.6,
1083	can_events => 1,	1153	can_events => 1,
1084	min_w => 16,	1154	min_w => 64,
1085	min_h => 16,	1155	min_h => 32,
1086	%arg,	1156	%arg,
1087	);	1157	);
1088		1158
1089	$self->{title} = new CFClient::UI::Label	1159	$self->{title_widget} = new CFClient::UI::Label
1090	align => 0,	1160	align => 0,
1091	valign => 1,	1161	valign => 1,
1092	text => $title,	1162	text => $self->{title},
1093	fontsize => $self->{border}	1163	fontsize => $self->{border},
1094	if defined $title;	1164	if exists $self->{title};
		1165
		1166	if ($self->{has_close_button}) {
		1167	$self->{close_button} =
		1168	new CFClient::UI::ImageButton
		1169	path => 'x1_close.png',
		1170	on_activate => sub { $self->emit ("delete") };
		1171
		1172	$self->CFClient::UI::Container::add ($self->{close_button});
		1173	}
1095		1174
1096	$self	1175	$self
1097	}	1176	}
1098		1177
1099	sub add {	1178	sub add {
1100	my ($self, @widgets) = @_;	1179	my ($self, @widgets) = @_;
1101		1180
1102	$self->SUPER::add (@widgets);	1181	$self->SUPER::add (@widgets);
		1182	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1103	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};	1183	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1104	}	1184	}
1105		1185
1106	sub border {	1186	sub border {
1107	int $_[0]{border} * $::FONTSIZE	1187	int $_[0]{border} * $::FONTSIZE
1108	}	1188	}
1109		1189
1110	sub size_request {	1190	sub size_request {
1111	my ($self) = @_;	1191	my ($self) = @_;
1112		1192
1113	$self->{title}->size_request	1193	$self->{title_widget}->size_request
1114	if $self->{title};	1194	if $self->{title_widget};
		1195
		1196	$self->{close_button}->size_request
		1197	if $self->{close_button};
1115		1198
1116	my ($w, $h) = $self->SUPER::size_request;	1199	my ($w, $h) = $self->SUPER::size_request;
1117		1200
1118	(	1201	(
1119	$w + $self->border * 2,	1202	$w + $self->border * 2,
1120	$h + $self->border * 2,	1203	$h + $self->border * 2,
1121	)	1204	)
1122	}	1205	}
1123		1206
1124	sub size_allocate {	1207	sub invoke_size_allocate {
1125	my ($self, $w, $h) = @_;	1208	my ($self, $w, $h) = @_;
1126		1209
1127	if ($self->{title}) {	1210	if ($self->{title_widget}) {
1128	$self->{title}{w} = $w;	1211	$self->{title_widget}{w} = $w;
1129	$self->{title}{h} = $h;	1212	$self->{title_widget}{h} = $h;
1130	$self->{title}->size_allocate ($w, $h);	1213	$self->{title_widget}->invoke_size_allocate ($w, $h);
1131	}	1214	}
1132		1215
1133	my $border = $self->border;	1216	my $border = $self->border;
1134		1217
1135	$h -= List::Util::max 0, $border * 2;	1218	$h -= List::Util::max 0, $border * 2;
1136	$w -= List::Util::max 0, $border * 2;	1219	$w -= List::Util::max 0, $border * 2;
		1220
		1221	$self->child->configure ($border, $border, $w, $h);
		1222
		1223	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1224	if $self->{close_button};
		1225
		1226	1
		1227	}
		1228
		1229	sub invoke_delete {
		1230	my ($self) = @_;
		1231
		1232	$self->hide;
1137		1233
1138	$self->child->configure ($border, $border, $w, $h);	1234	1
1139	}	1235	}
1140		1236
1141	sub button_down {	1237	sub invoke_button_down {
1142	my ($self, $ev, $x, $y) = @_;	1238	my ($self, $ev, $x, $y) = @_;
1143		1239
1144	my ($w, $h) = @$self{qw(w h)};	1240	my ($w, $h) = @$self{qw(w h)};
1145	my $border = $self->border;	1241	my $border = $self->border;
1146		1242
…		…
1177		1273
1178	($x, $y) = ($ev->{x}, $ev->{y});	1274	($x, $y) = ($ev->{x}, $ev->{y});
1179		1275
1180	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1276	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1181	# HACK: the next line is required to enforce placement	1277	# HACK: the next line is required to enforce placement
1182	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1278	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1183	};	1279	};
1184	} else {	1280	} else {
1185	return 0;	1281	return 0;
1186	}	1282	}
1187		1283
1188	1	1284	1
1189	}	1285	}
1190		1286
1191	sub button_up {	1287	sub invoke_button_up {
1192	my ($self, $ev, $x, $y) = @_;	1288	my ($self, $ev, $x, $y) = @_;
1193		1289
1194	!!delete $self->{motion}	1290	! ! delete $self->{motion}
1195	}	1291	}
1196		1292
1197	sub mouse_motion {	1293	sub invoke_mouse_motion {
1198	my ($self, $ev, $x, $y) = @_;	1294	my ($self, $ev, $x, $y) = @_;
1199		1295
1200	$self->{motion}->($ev, $x, $y) if $self->{motion};	1296	$self->{motion}->($ev, $x, $y) if $self->{motion};
1201		1297
1202	!!$self->{motion}	1298	! ! $self->{motion}
		1299	}
		1300
		1301	sub invoke_visibility_change {
		1302	my ($self, $visible) = @_;
		1303
		1304	delete $self->{motion} unless $visible;
		1305
		1306	0
1203	}	1307	}
1204		1308
1205	sub _draw {	1309	sub _draw {
1206	my ($self) = @_;	1310	my ($self) = @_;
1207		1311
…		…
1233		1337
1234	glDisable GL_TEXTURE_2D;	1338	glDisable GL_TEXTURE_2D;
1235		1339
1236	$child->draw;	1340	$child->draw;
1237		1341
1238	if ($self->{title}) {	1342	if ($self->{title_widget}) {
1239	glTranslate 0, $border - $self->{h};	1343	glTranslate 0, $border - $self->{h};
1240	$self->{title}->_draw;	1344	$self->{title_widget}->_draw;
		1345
		1346	glTranslate 0, - ($border - $self->{h});
1241	}	1347	}
		1348
		1349	$self->{close_button}->draw
		1350	if $self->{close_button};
1242	}	1351	}
1243		1352
1244	#############################################################################	1353	#############################################################################
1245		1354
1246	package CFClient::UI::Table;	1355	package CFClient::UI::Table;
…		…
1263	sub children {	1372	sub children {
1264	grep $_, map @$_, grep $_, @{ $_[0]{children} }	1373	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1265	}	1374	}
1266		1375
1267	sub add {	1376	sub add {
1268	my ($self, $x, $y, $child) = @_;	1377	my ($self) = shift;
1269		1378
		1379	while (@_) {
		1380	my ($x, $y, $child) = splice @_, 0, 3, ();
1270	$child->set_parent ($self);	1381	$child->set_parent ($self);
1271	$self->{children}[$y][$x] = $child;	1382	$self->{children}[$y][$x] = $child;
		1383	}
1272		1384
		1385	$self->{force_realloc} = 1;
		1386	$self->{force_size_alloc} = 1;
1273	$self->realloc;	1387	$self->realloc;
		1388	}
		1389
		1390	sub remove {
		1391	my ($self, $child) = @_;
		1392
		1393	# TODO: not yet implemented
1274	}	1394	}
1275		1395
1276	# TODO: move to container class maybe? send children a signal on removal?	1396	# TODO: move to container class maybe? send children a signal on removal?
1277	sub clear {	1397	sub clear {
1278	my ($self) = @_;	1398	my ($self) = @_;
…		…
1319	(sum @$ws),	1439	(sum @$ws),
1320	(sum @$hs),	1440	(sum @$hs),
1321	)	1441	)
1322	}	1442	}
1323		1443
1324	sub size_allocate {	1444	sub invoke_size_allocate {
1325	my ($self, $w, $h) = @_;	1445	my ($self, $w, $h) = @_;
1326		1446
1327	my ($ws, $hs) = $self->get_wh;	1447	my ($ws, $hs) = $self->get_wh;
1328		1448
1329	my $req_w = (sum @$ws) || 1;	1449	my $req_w = (sum @$ws) || 1;
…		…
1361	}	1481	}
1362		1482
1363	$y += $row_h;	1483	$y += $row_h;
1364	}	1484	}
1365		1485
		1486	1
1366	}	1487	}
1367		1488
1368	sub find_widget {	1489	sub find_widget {
1369	my ($self, $x, $y) = @_;	1490	my ($self, $x, $y) = @_;
1370		1491
…		…
1407	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1528	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1408	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1529	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1409	)	1530	)
1410	}	1531	}
1411		1532
1412	sub size_allocate {	1533	sub invoke_size_allocate {
1413	my ($self, $w, $h) = @_;	1534	my ($self, $w, $h) = @_;
1414		1535
1415	my $space = $self->{vertical} ? $h : $w;	1536	my $space = $self->{vertical} ? $h : $w;
1416	my $children = $self->{children};	1537	my @children = $self->visible_children;
1417		1538
1418	my @req;	1539	my @req;
1419		1540
1420	if ($self->{homogeneous}) {	1541	if ($self->{homogeneous}) {
1421	@req = ($space / (@$children || 1)) x @$children;	1542	@req = ($space / (@children || 1)) x @children;
1422	} else {	1543	} else {
1423	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1544	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1424	my $req = List::Util::sum @req;	1545	my $req = List::Util::sum @req;
1425		1546
1426	if ($req > $space) {	1547	if ($req > $space) {
1427	# ah well, not enough space	1548	# ah well, not enough space
1428	$_ *= $space / $req for @req;	1549	$_ *= $space / $req for @req;
1429	} else {	1550	} else {
1430	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1551	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1431		1552
1432	$space = ($space - $req) / $expand; # remaining space to give away	1553	$space = ($space - $req) / $expand; # remaining space to give away
1433		1554
1434	$req[$_] += $space * $children->[$_]{expand}	1555	$req[$_] += $space * $children[$_]{expand}
1435	for 0 .. $#$children;	1556	for 0 .. $#children;
1436	}	1557	}
1437	}	1558	}
1438		1559
1439	CFClient::UI::harmonize \@req;	1560	CFClient::UI::harmonize \@req;
1440		1561
1441	my $pos = 0;	1562	my $pos = 0;
1442	for (0 .. $#$children) {	1563	for (0 .. $#children) {
1443	my $alloc = $req[$_];	1564	my $alloc = $req[$_];
1444	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1565	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1445		1566
1446	$pos += $alloc;	1567	$pos += $alloc;
1447	}	1568	}
1448		1569
1449	1	1570	1
…		…
1522	}	1643	}
1523		1644
1524	$self	1645	$self
1525	}	1646	}
1526		1647
1527	sub escape($) {
1528	local $_ = $_[0];
1529
1530	s/&/&amp;/g;
1531	s/>/&gt;/g;
1532	s/</&lt;/g;
1533
1534	$_
1535	}
1536
1537	sub update {	1648	sub update {
1538	my ($self) = @_;	1649	my ($self) = @_;
1539		1650
1540	delete $self->{texture};	1651	delete $self->{texture};
1541	$self->SUPER::update;	1652	$self->SUPER::update;
…		…
1552	my ($self, $text) = @_;	1663	my ($self, $text) = @_;
1553		1664
1554	return if $self->{text} eq "T$text";	1665	return if $self->{text} eq "T$text";
1555	$self->{text} = "T$text";	1666	$self->{text} = "T$text";
1556		1667
1557	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1558	$self->{layout}->set_text ($text);	1668	$self->{layout}->set_text ($text);
1559		1669
1560	delete $self->{size_req};	1670	delete $self->{size_req};
1561	$self->realloc;	1671	$self->realloc;
1562	$self->update;	1672	$self->update;
…		…
1568	return if $self->{text} eq "M$markup";	1678	return if $self->{text} eq "M$markup";
1569	$self->{text} = "M$markup";	1679	$self->{text} = "M$markup";
1570		1680
1571	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1681	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1572		1682
1573	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1574	$self->{layout}->set_markup ($markup);	1683	$self->{layout}->set_markup ($markup);
1575		1684
1576	delete $self->{size_req};	1685	delete $self->{size_req};
1577	$self->realloc;	1686	$self->realloc;
1578	$self->update;	1687	$self->update;
…		…
1590		1699
1591	my ($w, $h) = $self->{layout}->size;	1700	my ($w, $h) = $self->{layout}->size;
1592		1701
1593	if (exists $self->{template}) {	1702	if (exists $self->{template}) {
1594	$self->{template}->set_font ($self->{font}) if $self->{font};	1703	$self->{template}->set_font ($self->{font}) if $self->{font};
		1704	$self->{template}->set_width ($self->{max_w} || -1);
1595	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1705	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1596		1706
1597	my ($w2, $h2) = $self->{template}->size;	1707	my ($w2, $h2) = $self->{template}->size;
1598		1708
1599	$w = List::Util::max $w, $w2;	1709	$w = List::Util::max $w, $w2;
…		…
1604	};	1714	};
1605		1715
1606	@{ $self->{size_req} }	1716	@{ $self->{size_req} }
1607	}	1717	}
1608		1718
		1719	sub baseline_shift {
		1720	$_[0]{layout}->descent
		1721	}
		1722
1609	sub size_allocate {	1723	sub invoke_size_allocate {
1610	my ($self, $w, $h) = @_;	1724	my ($self, $w, $h) = @_;
1611		1725
1612	delete $self->{ox};	1726	delete $self->{ox};
1613		1727
1614	delete $self->{texture}	1728	delete $self->{texture}
1615	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};	1729	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1730
		1731	1
1616	}	1732	}
1617		1733
1618	sub set_fontsize {	1734	sub set_fontsize {
1619	my ($self, $fontsize) = @_;	1735	my ($self, $fontsize) = @_;
1620		1736
1621	$self->{fontsize} = $fontsize;	1737	$self->{fontsize} = $fontsize;
		1738	delete $self->{size_req};
1622	delete $self->{texture};	1739	delete $self->{texture};
1623		1740
1624	$self->realloc;	1741	$self->realloc;
1625	}	1742	}
1626		1743
1627	sub reconfigure {	1744	sub reconfigure {
1628	my ($self) = @_;	1745	my ($self) = @_;
1629		1746
1630	delete $self->{size_req};	1747	delete $self->{size_req};
		1748	delete $self->{texture};
1631		1749
1632	$self->SUPER::reconfigure;	1750	$self->SUPER::reconfigure;
1633	}	1751	}
1634		1752
1635	sub _draw {	1753	sub _draw {
1636	my ($self) = @_;	1754	my ($self) = @_;
1637		1755
1638	$self->SUPER::_draw; # draw background, if applicable	1756	$self->SUPER::_draw; # draw background, if applicable
1639		1757
1640	my $tex = $self->{texture} ||= do {	1758	my $size = $self->{texture} ||= do {
1641	$self->{layout}->set_foreground (@{$self->{fg}});	1759	$self->{layout}->set_foreground (@{$self->{fg}});
1642	$self->{layout}->set_font ($self->{font}) if $self->{font};	1760	$self->{layout}->set_font ($self->{font}) if $self->{font};
1643	$self->{layout}->set_width ($self->{w});	1761	$self->{layout}->set_width ($self->{w});
1644	$self->{layout}->set_ellipsise ($self->{ellipsise});	1762	$self->{layout}->set_ellipsise ($self->{ellipsise});
1645	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1763	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1646	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1764	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1647		1765
1648	new_from_layout CFClient::Texture $self->{layout}	1766	[$self->{layout}->size]
1649	};	1767	};
1650		1768
1651	unless (exists $self->{ox}) {	1769	unless (exists $self->{ox}) {
1652	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1770	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1653	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1771	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1654	: ($self->{w} - $tex->{w}) * 0.5);	1772	: ($self->{w} - $size->[0]) * 0.5);
1655		1773
1656	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1774	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1657	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1775	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1658	: ($self->{h} - $tex->{h}) * 0.5);	1776	: ($self->{h} - $size->[1]) * 0.5);
1659	};	1777	};
1660		1778
1661	glEnable GL_TEXTURE_2D;
1662
1663	my $w = List::Util::min $self->{w} + 4, $tex->{w};	1779	my $w = List::Util::min $self->{w} + 4, $size->[0];
1664	my $h = List::Util::min $self->{h} + 2, $tex->{h};	1780	my $h = List::Util::min $self->{h} + 2, $size->[1];
1665		1781
1666	if ($tex->{format} == GL_ALPHA) {	1782	$self->{layout}->render ($self->{ox}, $self->{oy});
1667	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1668	glColor @{$self->{fg}};
1669	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1670	} else {
1671	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1672	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1673	}
1674
1675	glDisable GL_TEXTURE_2D;
1676	}	1783	}
1677		1784
1678	#############################################################################	1785	#############################################################################
1679		1786
1680	package CFClient::UI::EntryBase;	1787	package CFClient::UI::EntryBase;
…		…
1713		1820
1714	$text =~ s/./*/g if $self->{hidden};	1821	$text =~ s/./*/g if $self->{hidden};
1715	$self->{layout}->set_text ("$text ");	1822	$self->{layout}->set_text ("$text ");
1716	delete $self->{size_req};	1823	delete $self->{size_req};
1717		1824
1718	$self->_emit (changed => $self->{text});	1825	$self->emit (changed => $self->{text});
1719		1826
1720	$self->realloc;	1827	$self->realloc;
1721	$self->update;	1828	$self->update;
1722	}	1829	}
1723		1830
…		…
1738	my ($w, $h) = $self->SUPER::size_request;	1845	my ($w, $h) = $self->SUPER::size_request;
1739		1846
1740	($w + 1, $h) # add 1 for cursor	1847	($w + 1, $h) # add 1 for cursor
1741	}	1848	}
1742		1849
1743	sub key_down {	1850	sub invoke_key_down {
1744	my ($self, $ev) = @_;	1851	my ($self, $ev) = @_;
1745		1852
1746	my $mod = $ev->{mod};	1853	my $mod = $ev->{mod};
1747	my $sym = $ev->{sym};	1854	my $sym = $ev->{sym};
1748	my $uni = $ev->{unicode};	1855	my $uni = $ev->{unicode};
…		…
1760	} elsif ($sym == CFClient::SDLK_HOME) {	1867	} elsif ($sym == CFClient::SDLK_HOME) {
1761	$self->{cursor} = 0;	1868	$self->{cursor} = 0;
1762	} elsif ($sym == CFClient::SDLK_END) {	1869	} elsif ($sym == CFClient::SDLK_END) {
1763	$self->{cursor} = length $text;	1870	$self->{cursor} = length $text;
1764	} elsif ($uni == 27) {	1871	} elsif ($uni == 27) {
1765	$self->_emit ('escape');	1872	$self->emit ('escape');
1766	} elsif ($uni) {	1873	} elsif ($uni) {
1767	substr $text, $self->{cursor}++, 0, chr $uni;	1874	substr $text, $self->{cursor}++, 0, chr $uni;
1768	} else {	1875	} else {
1769	return 0;	1876	return 0;
1770	}	1877	}
…		…
1774	$self->realloc;	1881	$self->realloc;
1775		1882
1776	1	1883	1
1777	}	1884	}
1778		1885
1779	sub focus_in {	1886	sub invoke_focus_in {
1780	my ($self) = @_;	1887	my ($self) = @_;
1781		1888
1782	$self->{last_activity} = $::NOW;	1889	$self->{last_activity} = $::NOW;
1783		1890
1784	$self->SUPER::focus_in;	1891	$self->SUPER::invoke_focus_in
1785	}	1892	}
1786		1893
1787	sub button_down {	1894	sub invoke_button_down {
1788	my ($self, $ev, $x, $y) = @_;	1895	my ($self, $ev, $x, $y) = @_;
1789		1896
1790	$self->SUPER::button_down ($ev, $x, $y);	1897	$self->SUPER::invoke_button_down ($ev, $x, $y);
1791		1898
1792	my $idx = $self->{layout}->xy_to_index ($x, $y);	1899	my $idx = $self->{layout}->xy_to_index ($x, $y);
1793		1900
1794	# byte-index to char-index	1901	# byte-index to char-index
1795	my $text = $self->{text};	1902	my $text = $self->{text};
1796	utf8::encode $text;	1903	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1797	$self->{cursor} = length substr $text, 0, $idx;	1904	$self->{cursor} = length $text;
1798		1905
1799	$self->_set_text ($self->{text});	1906	$self->_set_text ($self->{text});
1800	$self->update;	1907	$self->update;
1801		1908
1802	1	1909	1
1803	}	1910	}
1804		1911
1805	sub mouse_motion {	1912	sub invoke_mouse_motion {
1806	my ($self, $ev, $x, $y) = @_;	1913	my ($self, $ev, $x, $y) = @_;
1807	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1914	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1808		1915
1809	0	1916	1
1810	}	1917	}
1811		1918
1812	sub _draw {	1919	sub _draw {
1813	my ($self) = @_;	1920	my ($self) = @_;
1814		1921
…		…
1855		1962
1856	our @ISA = CFClient::UI::EntryBase::;	1963	our @ISA = CFClient::UI::EntryBase::;
1857		1964
1858	use CFClient::OpenGL;	1965	use CFClient::OpenGL;
1859		1966
1860	sub key_down {	1967	sub invoke_key_down {
1861	my ($self, $ev) = @_;	1968	my ($self, $ev) = @_;
1862		1969
1863	my $sym = $ev->{sym};	1970	my $sym = $ev->{sym};
1864		1971
1865	if ($sym == 13) {	1972	if ($sym == 13) {
1866	unshift @{$self->{history}},	1973	unshift @{$self->{history}},
1867	my $txt = $self->get_text;	1974	my $txt = $self->get_text;
		1975
1868	$self->{history_pointer} = -1;	1976	$self->{history_pointer} = -1;
1869	$self->{history_saveback} = '';	1977	$self->{history_saveback} = '';
1870	$self->_emit (activate => $txt);	1978	$self->emit (activate => $txt);
1871	$self->update;	1979	$self->update;
1872		1980
1873	} elsif ($sym == CFClient::SDLK_UP) {	1981	} elsif ($sym == CFClient::SDLK_UP) {
1874	if ($self->{history_pointer} < 0) {	1982	if ($self->{history_pointer} < 0) {
1875	$self->{history_saveback} = $self->get_text;	1983	$self->{history_saveback} = $self->get_text;
…		…
1891	} else {	1999	} else {
1892	$self->set_text ($self->{history_saveback});	2000	$self->set_text ($self->{history_saveback});
1893	}	2001	}
1894		2002
1895	} else {	2003	} else {
1896	return $self->SUPER::key_down ($ev)	2004	return $self->SUPER::invoke_key_down ($ev)
1897	}	2005	}
1898		2006
1899	1	2007	1
1900	}	2008	}
1901		2009
…		…
1925	can_events => 1,	2033	can_events => 1,
1926	@_	2034	@_
1927	)	2035	)
1928	}	2036	}
1929		2037
1930	sub activate { }
1931
1932	sub button_up {	2038	sub invoke_button_up {
1933	my ($self, $ev, $x, $y) = @_;	2039	my ($self, $ev, $x, $y) = @_;
1934		2040
1935	$self->emit ("activate")	2041	$self->emit ("activate")
1936	if $x >= 0 && $x < $self->{w}	2042	if $x >= 0 && $x < $self->{w}
1937	&& $y >= 0 && $y < $self->{h};	2043	&& $y >= 0 && $y < $self->{h};
…		…
1987	my ($self) = @_;	2093	my ($self) = @_;
1988		2094
1989	(6) x 2	2095	(6) x 2
1990	}	2096	}
1991		2097
		2098	sub toggle {
		2099	my ($self) = @_;
		2100
		2101	$self->{state} = !$self->{state};
		2102	$self->emit (changed => $self->{state});
		2103	$self->update;
		2104	}
		2105
1992	sub button_down {	2106	sub invoke_button_down {
1993	my ($self, $ev, $x, $y) = @_;	2107	my ($self, $ev, $x, $y) = @_;
1994		2108
1995	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2109	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1996	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2110	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1997	$self->{state} = !$self->{state};	2111	$self->toggle;
1998	$self->_emit (changed => $self->{state});
1999	} else {	2112	} else {
2000	return 0	2113	return 0
2001	}	2114	}
2002		2115
2003	1	2116	1
…		…
2028	package CFClient::UI::Image;	2141	package CFClient::UI::Image;
2029		2142
2030	our @ISA = CFClient::UI::Base::;	2143	our @ISA = CFClient::UI::Base::;
2031		2144
2032	use CFClient::OpenGL;	2145	use CFClient::OpenGL;
2033	use Carp qw/confess/;
2034		2146
2035	our %loaded_images;	2147	our %texture_cache;
2036		2148
2037	sub new {	2149	sub new {
2038	my $class = shift;	2150	my $class = shift;
2039		2151
2040	my $self = $class->SUPER::new (can_events => 0, @_);	2152	my $self = $class->SUPER::new (
		2153	can_events => 0,
		2154	@_,
		2155	);
2041		2156
2042	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2157	$self->{path} || $self->{tex}
		2158	or Carp::croak "'path' or 'tex' attributes required";
2043		2159
2044	$loaded_images{$self->{image}} ||=	2160	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2045	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2161	new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2046		2162
2047	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2163	Scalar::Util::weaken $texture_cache{$self->{path}};
2048		2164
2049	Scalar::Util::weaken $loaded_images{$self->{image}};	2165	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2050
2051	$self->{aspect} = $tex->{w} / $tex->{h};
2052		2166
2053	$self	2167	$self
2054	}	2168	}
2055		2169
		2170	sub STORABLE_freeze {
		2171	my ($self, $cloning) = @_;
		2172
		2173	$self->{path}
		2174	or die "cannot serialise CFClient::UI::Image on non-loadable images\n";
		2175
		2176	$self->{path}
		2177	}
		2178
		2179	sub STORABLE_attach {
		2180	my ($self, $cloning, $path) = @_;
		2181
		2182	$self->new (path => $path)
		2183	}
		2184
2056	sub size_request {	2185	sub size_request {
2057	my ($self) = @_;	2186	my ($self) = @_;
2058		2187
2059	($self->{tex}->{w}, $self->{tex}->{h})	2188	($self->{tex}{w}, $self->{tex}{h})
2060	}	2189	}
2061		2190
2062	sub _draw {	2191	sub _draw {
2063	my ($self) = @_;	2192	my ($self) = @_;
2064		2193
…		…
2074	}	2203	}
2075		2204
2076	glEnable GL_TEXTURE_2D;	2205	glEnable GL_TEXTURE_2D;
2077	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2206	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2078		2207
2079	$tex->draw_quad_alpha (0, 0, $w, $h);	2208	$tex->draw_quad (0, 0, $w, $h);
2080		2209
2081	glDisable GL_TEXTURE_2D;	2210	glDisable GL_TEXTURE_2D;
		2211	}
		2212
		2213	#############################################################################
		2214
		2215	package CFClient::UI::ImageButton;
		2216
		2217	our @ISA = CFClient::UI::Image::;
		2218
		2219	use CFClient::OpenGL;
		2220
		2221	my %textures;
		2222
		2223	sub new {
		2224	my $class = shift;
		2225
		2226	my $self = $class->SUPER::new (
		2227	padding_x => 4,
		2228	padding_y => 4,
		2229	fg => [1, 1, 1],
		2230	active_fg => [0, 0, 1],
		2231	can_hover => 1,
		2232	align => 0,
		2233	valign => 0,
		2234	can_events => 1,
		2235	@_
		2236	);
		2237	}
		2238
		2239	sub invoke_button_up {
		2240	my ($self, $ev, $x, $y) = @_;
		2241
		2242	$self->emit ("activate")
		2243	if $x >= 0 && $x < $self->{w}
		2244	&& $y >= 0 && $y < $self->{h};
		2245
		2246	1
2082	}	2247	}
2083		2248
2084	#############################################################################	2249	#############################################################################
2085		2250
2086	package CFClient::UI::VGauge;	2251	package CFClient::UI::VGauge;
…		…
2173	my $ycut1 = max 0, min 1, $ycut;	2338	my $ycut1 = max 0, min 1, $ycut;
2174	my $ycut2 = max 0, min 1, $ycut - 1;	2339	my $ycut2 = max 0, min 1, $ycut - 1;
2175		2340
2176	my $h1 = $self->{h} * (1 - $ycut1);	2341	my $h1 = $self->{h} * (1 - $ycut1);
2177	my $h2 = $self->{h} * (1 - $ycut2);	2342	my $h2 = $self->{h} * (1 - $ycut2);
		2343	my $h3 = $self->{h};
		2344
		2345	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2178		2346
2179	glEnable GL_BLEND;	2347	glEnable GL_BLEND;
2180	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2348	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2181	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2349	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2182	glEnable GL_TEXTURE_2D;	2350	glEnable GL_TEXTURE_2D;
…		…
2201		2369
2202	if ($t3) {	2370	if ($t3) {
2203	glBindTexture GL_TEXTURE_2D, $t3->{name};	2371	glBindTexture GL_TEXTURE_2D, $t3->{name};
2204	glBegin GL_QUADS;	2372	glBegin GL_QUADS;
2205	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2373	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2206	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2374	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2207	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2375	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2208	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2376	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2209	glEnd;	2377	glEnd;
2210	}	2378	}
2211		2379
2212	glDisable GL_BLEND;	2380	glDisable GL_BLEND;
…		…
2300	$self->update;	2468	$self->update;
2301		2469
2302	$self	2470	$self
2303	}	2471	}
2304		2472
2305	sub changed { }
2306
2307	sub set_range {	2473	sub set_range {
2308	my ($self, $range) = @_;	2474	my ($self, $range) = @_;
2309		2475
2310	($range, $self->{range}) = ($self->{range}, $range);	2476	($range, $self->{range}) = ($self->{range}, $range);
2311		2477
…		…
2331	if $unit;	2497	if $unit;
2332		2498
2333	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2499	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2334		2500
2335	if ($value != $old_value) {	2501	if ($value != $old_value) {
2336	$self->_emit (changed => $value);	2502	$self->emit (changed => $value);
2337	$self->update;	2503	$self->update;
2338	}	2504	}
2339	}	2505	}
2340		2506
2341	sub size_request {	2507	sub size_request {
2342	my ($self) = @_;	2508	my ($self) = @_;
2343		2509
2344	($self->{req_w}, $self->{req_h})	2510	($self->{req_w}, $self->{req_h})
2345	}	2511	}
2346		2512
2347	sub button_down {	2513	sub invoke_button_down {
2348	my ($self, $ev, $x, $y) = @_;	2514	my ($self, $ev, $x, $y) = @_;
2349		2515
2350	$self->SUPER::button_down ($ev, $x, $y);	2516	$self->SUPER::invoke_button_down ($ev, $x, $y);
2351		2517
2352	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2518	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2353		2519
2354	$self->mouse_motion ($ev, $x, $y)	2520	$self->invoke_mouse_motion ($ev, $x, $y)
2355	}	2521	}
2356		2522
2357	sub mouse_motion {	2523	sub invoke_mouse_motion {
2358	my ($self, $ev, $x, $y) = @_;	2524	my ($self, $ev, $x, $y) = @_;
2359		2525
2360	if ($GRAB == $self) {	2526	if ($GRAB == $self) {
2361	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2527	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2362		2528
…		…
2368	} else {	2534	} else {
2369	return 0;	2535	return 0;
2370	}	2536	}
2371		2537
2372	1	2538	1
		2539	}
		2540
		2541	sub invoke_mouse_wheel {
		2542	my ($self, $ev) = @_;
		2543
		2544	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2545
		2546	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.2);
		2547
		2548	! ! $delta
2373	}	2549	}
2374		2550
2375	sub update {	2551	sub update {
2376	my ($self) = @_;	2552	my ($self) = @_;
2377		2553
…		…
2478	sub new {	2654	sub new {
2479	my $class = shift;	2655	my $class = shift;
2480		2656
2481	my $self = $class->SUPER::new (	2657	my $self = $class->SUPER::new (
2482	fontsize => 1,	2658	fontsize => 1,
2483	can_events => 0,	2659	can_events => 1,
2484	indent => 0,	2660	indent => 0,
2485	#font => default_font	2661	#font => default_font
2486	@_,	2662	@_,
2487		2663
2488	layout => (new CFClient::Layout 1),	2664	layout => (new CFClient::Layout),
2489	par => [],	2665	par => [],
2490	height => 0,	2666	height => 0,
2491	children => [	2667	children => [
2492	(new CFClient::UI::Empty expand => 1),	2668	(new CFClient::UI::Empty expand => 1),
2493	(new CFClient::UI::Slider vertical => 1),	2669	(new CFClient::UI::Slider vertical => 1),
…		…
2504		2680
2505	$self->{fontsize} = $fontsize;	2681	$self->{fontsize} = $fontsize;
2506	$self->reflow;	2682	$self->reflow;
2507	}	2683	}
2508		2684
		2685	sub size_request {
		2686	my ($self) = @_;
		2687
		2688	my ($empty, $slider) = @{ $self->{children} };
		2689
		2690	local $self->{children} = [$empty, $slider];
		2691	$self->SUPER::size_request
		2692	}
		2693
2509	sub size_allocate {	2694	sub invoke_size_allocate {
2510	my ($self, $w, $h) = @_;	2695	my ($self, $w, $h) = @_;
2511		2696
2512	$self->SUPER::size_allocate ($w, $h);	2697	my ($empty, $slider, @other) = @{ $self->{children} };
		2698	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2513		2699
2514	$self->{layout}->set_font ($self->{font}) if $self->{font};	2700	$self->{layout}->set_font ($self->{font}) if $self->{font};
2515	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2701	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2516	$self->{layout}->set_width ($self->{children}[0]{w});	2702	$self->{layout}->set_width ($empty->{w});
2517	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2703	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2518		2704
2519	$self->reflow;	2705	$self->reflow;
2520	}
2521		2706
2522	sub text_size {	2707	local $self->{children} = [$empty, $slider];
		2708	$self->SUPER::invoke_size_allocate ($w, $h)
		2709	}
		2710
		2711	sub invoke_mouse_wheel {
2523	my ($self, $text, $indent) = @_;	2712	my ($self, $ev) = @_;
		2713
		2714	return 0 unless $ev->{dy}; # only vertical movements
		2715
		2716	$self->{children}[1]->emit (mouse_wheel => $ev);
		2717
		2718	1
		2719	}
		2720
		2721	sub get_layout {
		2722	my ($self, $para) = @_;
2524		2723
2525	my $layout = $self->{layout};	2724	my $layout = $self->{layout};
2526		2725
		2726	$layout->set_font ($self->{font}) if $self->{font};
		2727	$layout->set_foreground (@{$para->{fg}});
2527	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2728	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2528	$layout->set_width ($self->{children}[0]{w} - $indent);	2729	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2529	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2730	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2530	$layout->set_markup ($text);	2731	$layout->set_markup ($para->{markup});
		2732
		2733	$layout->set_shapes (
		2734	map
		2735	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		2736	@{$para->{widget}}
2531		2737	);
		2738
2532	$layout->size	2739	$layout
2533	}	2740	}
2534		2741
2535	sub reflow {	2742	sub reflow {
2536	my ($self) = @_;	2743	my ($self) = @_;
2537		2744
…		…
2546	$self->{children}[1]->set_value ($offset);	2753	$self->{children}[1]->set_value ($offset);
2547	}	2754	}
2548		2755
2549	sub clear {	2756	sub clear {
2550	my ($self) = @_;	2757	my ($self) = @_;
		2758
		2759	my (undef, undef, @other) = @{ $self->{children} };
		2760	$self->remove ($_) for @other;
2551		2761
2552	$self->{par} = [];	2762	$self->{par} = [];
2553	$self->{height} = 0;	2763	$self->{height} = 0;
2554	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2764	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2555	}	2765	}
2556		2766
2557	sub add_paragraph {	2767	sub add_paragraph {
2558	my ($self, $color, $text, $indent) = @_;	2768	my $self = shift;
2559		2769
2560	for my $line (split /\n/, $text) {	2770	for my $para (@_) {
2561	my ($w, $h) = $self->text_size ($line);	2771	$para = {
2562	$self->{height} += $h;	2772	fg => [1, 1, 1, 1],
2563	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	2773	indent => 0,
2564	}	2774	markup => "",
		2775	widget => [],
		2776	ref $para ? %$para : (markup => $para),
		2777	w => 1e10,
		2778	wrapped => 1,
		2779	};
2565		2780
2566	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	2781	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		2782	push @{$self->{par}}, $para;
		2783	}
		2784
		2785	$self->{need_reflow}++;
		2786	$self->update;
		2787	}
		2788
		2789	sub scroll_to_bottom {
		2790	my ($self) = @_;
		2791
		2792	$self->{scroll_to_bottom} = 1;
		2793	$self->update;
2567	}	2794	}
2568		2795
2569	sub update {	2796	sub update {
2570	my ($self) = @_;	2797	my ($self) = @_;
2571		2798
…		…
2579	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2806	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2580		2807
2581	if (delete $self->{need_reflow}) {	2808	if (delete $self->{need_reflow}) {
2582	my $height = 0;	2809	my $height = 0;
2583		2810
2584	my $layout = $self->{layout};
2585
2586	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2587
2588	for (@{$self->{par}}) {	2811	for my $para (@{$self->{par}}) {
2589	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2812	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2590	$layout->set_width ($W - $_->[3]);	2813	my $layout = $self->get_layout ($para);
2591	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2592	$layout->set_markup ($_->[4]);
2593	my ($w, $h) = $layout->size;	2814	my ($w, $h) = $layout->size;
2594	$_->[0] = $w + $_->[3];	2815
2595	$_->[1] = $h;	2816	$para->{w} = $w + $para->{indent};
		2817	$para->{h} = $h;
		2818	$para->{wrapped} = $layout->has_wrapped;
2596	}	2819	}
2597		2820
2598	$height += $_->[1];	2821	$height += $para->{h};
2599	}	2822	}
2600		2823
2601	$self->{height} = $height;	2824	$self->{height} = $height;
2602		2825
2603	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2826	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2604		2827
2605	delete $self->{texture};	2828	delete $self->{texture};
		2829	}
		2830
		2831	if (delete $self->{scroll_to_bottom}) {
		2832	$self->{children}[1]->set_value (1e10);
2606	}	2833	}
2607		2834
2608	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2835	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2609	glClearColor 0, 0, 0, 0;	2836	glClearColor 0, 0, 0, 0;
2610	glClear GL_COLOR_BUFFER_BIT;	2837	glClear GL_COLOR_BUFFER_BIT;
…		…
2614	my $y0 = $top;	2841	my $y0 = $top;
2615	my $y1 = $top + $H;	2842	my $y1 = $top + $H;
2616		2843
2617	my $y = 0;	2844	my $y = 0;
2618		2845
2619	my $layout = $self->{layout};
2620
2621	$layout->set_font ($self->{font}) if $self->{font};
2622
2623	glEnable GL_BLEND;
2624	#TODO# not correct in windows where rgba is forced off
2625	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2626
2627	for my $par (@{$self->{par}}) {	2846	for my $para (@{$self->{par}}) {
2628	my $h = $par->[1];	2847	my $h = $para->{h};
2629		2848
2630	if ($y0 < $y + $h && $y < $y1) {	2849	if ($y0 < $y + $h && $y < $y1) {
2631	$layout->set_foreground (@{ $par->[2] });
2632	$layout->set_width ($W - $par->[3]);
2633	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2634	$layout->set_markup ($par->[4]);
2635		2850
2636	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2851	my $layout = $self->get_layout ($para);
2637		2852
2638	glRasterPos $par->[3], $y - $y0;	2853	$layout->render ($para->{indent}, $y - $y0);
2639	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	2854
		2855	if (my @w = @{ $para->{widget} }) {
		2856	my @s = $layout->get_shapes;
		2857
		2858	for (@w) {
		2859	my ($dx, $dy) = splice @s, 0, 2, ();
		2860
		2861	$_->{x} = $dx + $para->{indent};
		2862	$_->{y} = $dy + $y - $y0;
		2863
		2864	$_->draw;
		2865	}
		2866	}
2640	}	2867	}
2641		2868
2642	$y += $h;	2869	$y += $h;
2643	}	2870	}
2644
2645	glDisable GL_BLEND;
2646	};	2871	};
2647	});	2872	});
		2873	}
		2874
		2875	sub reconfigure {
		2876	my ($self) = @_;
		2877
		2878	$self->SUPER::reconfigure;
		2879
		2880	$_->{w} = 1e10 for @{ $self->{par} };
		2881	$self->reflow;
2648	}	2882	}
2649		2883
2650	sub _draw {	2884	sub _draw {
2651	my ($self) = @_;	2885	my ($self) = @_;
2652		2886
…		…
2655	glColor 0, 0, 0, 1;	2889	glColor 0, 0, 0, 1;
2656	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2890	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2657	glDisable GL_TEXTURE_2D;	2891	glDisable GL_TEXTURE_2D;
2658		2892
2659	$self->{children}[1]->draw;	2893	$self->{children}[1]->draw;
2660
2661	}	2894	}
2662		2895
2663	#############################################################################	2896	#############################################################################
2664		2897
2665	package CFClient::UI::Animator;	2898	package CFClient::UI::Animator;
…		…
2774	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	3007	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2775		3008
2776	($w + 4, $h + 4)	3009	($w + 4, $h + 4)
2777	}	3010	}
2778		3011
2779	sub size_allocate {	3012	sub invoke_size_allocate {
2780	my ($self, $w, $h) = @_;	3013	my ($self, $w, $h) = @_;
2781		3014
2782	$self->SUPER::size_allocate ($w - 4, $h - 4);	3015	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2783	}	3016	}
2784		3017
2785	sub visibility_change {	3018	sub invoke_visibility_change {
2786	my ($self, $visible) = @_;	3019	my ($self, $visible) = @_;
2787		3020
2788	return unless $visible;	3021	return unless $visible;
2789		3022
2790	$self->{root}->on_post_alloc ("move_$self" => sub {	3023	$self->{root}->on_post_alloc ("move_$self" => sub {
2791	my $widget = $self->{owner}	3024	my $widget = $self->{owner}
2792	or return;	3025	or return;
2793		3026
		3027	if ($widget->{visible}) {
2794	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3028	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2795		3029
2796	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3030	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2797	if $x + $self->{w} > $self->{root}{w};	3031	if $x + $self->{w} > $self->{root}{w};
2798		3032
2799	$self->move_abs ($x, $y);	3033	$self->move_abs ($x, $y);
		3034	} else {
		3035	$self->hide;
		3036	}
2800	});	3037	});
2801	}	3038	}
2802		3039
2803	sub _draw {	3040	sub _draw {
2804	my ($self) = @_;	3041	my ($self) = @_;
…		…
2830		3067
2831	#############################################################################	3068	#############################################################################
2832		3069
2833	package CFClient::UI::Face;	3070	package CFClient::UI::Face;
2834		3071
2835	our @ISA = CFClient::UI::Base::;	3072	our @ISA = CFClient::UI::DrawBG::;
2836		3073
2837	use CFClient::OpenGL;	3074	use CFClient::OpenGL;
2838		3075
2839	sub new {	3076	sub new {
2840	my $class = shift;	3077	my $class = shift;
…		…
2877	sub _draw {	3114	sub _draw {
2878	my ($self) = @_;	3115	my ($self) = @_;
2879		3116
2880	return unless $::CONN;	3117	return unless $::CONN;
2881		3118
		3119	$self->SUPER::_draw;
		3120
2882	my $face;	3121	my $face;
2883		3122
2884	if ($self->{frame}) {	3123	if ($self->{frame}) {
2885	my $anim = $::CONN->{anim}[$self->{anim}];	3124	my $anim = $::CONN->{anim}[$self->{anim}];
2886		3125
…		…
2897	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3136	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2898	glDisable GL_TEXTURE_2D;	3137	glDisable GL_TEXTURE_2D;
2899	}	3138	}
2900	}	3139	}
2901		3140
2902	sub DESTROY {	3141	sub destroy {
2903	my ($self) = @_;	3142	my ($self) = @_;
2904		3143
2905	$self->{timer}->cancel	3144	$self->{timer}->cancel
2906	if $self->{timer};	3145	if $self->{timer};
2907		3146
2908	$self->SUPER::DESTROY;	3147	$self->SUPER::destroy;
2909	}	3148	}
2910		3149
2911	#############################################################################	3150	#############################################################################
2912		3151
2913	package CFClient::UI::Buttonbar;	3152	package CFClient::UI::Buttonbar;
…		…
2938	for my $item (@{ $self->{items} }) {	3177	for my $item (@{ $self->{items} }) {
2939	my ($widget, $cb, $tooltip) = @$item;	3178	my ($widget, $cb, $tooltip) = @$item;
2940		3179
2941	# handle various types of items, only text for now	3180	# handle various types of items, only text for now
2942	if (!ref $widget) {	3181	if (!ref $widget) {
		3182	if ($widget =~ /\t/) {
		3183	my ($left, $right) = split /\t/, $widget, 2;
		3184
		3185	$widget = new CFClient::UI::HBox
		3186	can_hover => 1,
		3187	can_events => 1,
		3188	tooltip => $tooltip,
		3189	children => [
		3190	(new CFClient::UI::Label markup => $left, expand => 1),
		3191	(new CFClient::UI::Label markup => $right, align => +1),
		3192	],
		3193	;
		3194
		3195	} else {
2943	$widget = new CFClient::UI::Label	3196	$widget = new CFClient::UI::Label
2944	can_hover => 1,	3197	can_hover => 1,
2945	can_events => 1,	3198	can_events => 1,
2946	markup => $widget,	3199	markup => $widget,
2947	tooltip => $tooltip	3200	tooltip => $tooltip;
		3201	}
2948	}	3202	}
2949		3203
2950	$self->{item}{$widget} = $item;	3204	$self->{item}{$widget} = $item;
2951		3205
2952	$self->{vbox}->add ($widget);	3206	$self->{vbox}->add ($widget);
…		…
2957		3211
2958	# popup given the event (must be a mouse button down event currently)	3212	# popup given the event (must be a mouse button down event currently)
2959	sub popup {	3213	sub popup {
2960	my ($self, $ev) = @_;	3214	my ($self, $ev) = @_;
2961		3215
2962	$self->_emit ("popdown");	3216	$self->emit ("popdown");
2963		3217
2964	# maybe save $GRAB? must be careful about events...	3218	# maybe save $GRAB? must be careful about events...
2965	$GRAB = $self;	3219	$GRAB = $self;
2966	$self->{button} = $ev->{button};	3220	$self->{button} = $ev->{button};
2967		3221
2968	$self->show;	3222	$self->show;
2969	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3223	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2970	}	3224	}
2971		3225
2972	sub mouse_motion {	3226	sub invoke_mouse_motion {
2973	my ($self, $ev, $x, $y) = @_;	3227	my ($self, $ev, $x, $y) = @_;
2974		3228
2975	# TODO: should use vbox->find_widget or so	3229	# TODO: should use vbox->find_widget or so
2976	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3230	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2977	$self->{hover} = $self->{item}{$HOVER};	3231	$self->{hover} = $self->{item}{$HOVER};
2978		3232
2979	0	3233	0
2980	}	3234	}
2981		3235
2982	sub button_up {	3236	sub invoke_button_up {
2983	my ($self, $ev, $x, $y) = @_;	3237	my ($self, $ev, $x, $y) = @_;
2984		3238
2985	if ($ev->{button} == $self->{button}) {	3239	if ($ev->{button} == $self->{button}) {
2986	undef $GRAB;	3240	undef $GRAB;
2987	$self->hide;	3241	$self->hide;
2988		3242
2989	$self->_emit ("popdown");	3243	$self->emit ("popdown");
2990	$self->{hover}[1]->() if $self->{hover};	3244	$self->{hover}[1]->() if $self->{hover};
2991	} else {	3245	} else {
2992	return 0	3246	return 0
2993	}	3247	}
2994		3248
…		…
3021		3275
3022	$self->{current} = $self->{children}[0]	3276	$self->{current} = $self->{children}[0]
3023	if @{ $self->{children} };	3277	if @{ $self->{children} };
3024	}	3278	}
3025		3279
		3280	sub get_current_page {
		3281	my ($self) = @_;
		3282
		3283	$self->{current}
		3284	}
		3285
3026	sub set_current_page {	3286	sub set_current_page {
3027	my ($self, $page_or_widget) = @_;	3287	my ($self, $page_or_widget) = @_;
3028		3288
3029	my $widget = ref $page_or_widget	3289	my $widget = ref $page_or_widget
3030	? $page_or_widget	3290	? $page_or_widget
3031	: $self->{children}[$page_or_widget];	3291	: $self->{children}[$page_or_widget];
3032		3292
3033	$self->{current} = $widget;	3293	$self->{current} = $widget;
3034	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3294	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3035		3295
3036	$self->_emit (page_changed => $self->{current});	3296	$self->emit (page_changed => $self->{current});
3037		3297
3038	$self->realloc;	3298	$self->realloc;
3039	}	3299	}
3040		3300
3041	sub visible_children {	3301	sub visible_children {
…		…
3046	my ($self) = @_;	3306	my ($self) = @_;
3047		3307
3048	$self->{current}->size_request	3308	$self->{current}->size_request
3049	}	3309	}
3050		3310
3051	sub size_allocate {	3311	sub invoke_size_allocate {
3052	my ($self, $w, $h) = @_;	3312	my ($self, $w, $h) = @_;
3053		3313
3054	$self->{current}->configure (0, 0, $w, $h);	3314	$self->{current}->configure (0, 0, $w, $h);
		3315
		3316	1
3055	}	3317	}
3056		3318
3057	sub _draw {	3319	sub _draw {
3058	my ($self) = @_;	3320	my ($self) = @_;
3059		3321
…		…
3094	);	3356	);
3095		3357
3096	$self->{multiplexer}->add ($widget);	3358	$self->{multiplexer}->add ($widget);
3097	}	3359	}
3098		3360
		3361	sub get_current_page {
		3362	my ($self) = @_;
		3363
		3364	$self->{multiplexer}->get_current_page
		3365	}
		3366
3099	sub set_current_page {	3367	sub set_current_page {
3100	my ($self, $page) = @_;	3368	my ($self, $page) = @_;
3101		3369
3102	$self->{multiplexer}->set_current_page ($page);	3370	$self->{multiplexer}->set_current_page ($page);
3103	$self->_emit (page_changed => $self->{multiplexer}{current});	3371	$self->emit (page_changed => $self->{multiplexer}{current});
3104	}	3372	}
3105		3373
3106	#############################################################################	3374	#############################################################################
3107		3375
3108	package CFClient::UI::Combobox;	3376	package CFClient::UI::Selector;
3109		3377
3110	use utf8;	3378	use utf8;
3111		3379
3112	our @ISA = CFClient::UI::Button::;	3380	our @ISA = CFClient::UI::Button::;
3113		3381
…		…
3123	$self->_set_value ($self->{value});	3391	$self->_set_value ($self->{value});
3124		3392
3125	$self	3393	$self
3126	}	3394	}
3127		3395
3128	sub button_down {	3396	sub invoke_button_down {
3129	my ($self, $ev) = @_;	3397	my ($self, $ev) = @_;
3130		3398
3131	my @menu_items;	3399	my @menu_items;
3132		3400
3133	for (@{ $self->{options} }) {	3401	for (@{ $self->{options} }) {
…		…
3154	my ($self, $value) = @_;	3422	my ($self, $value) = @_;
3155		3423
3156	return unless $self->{value} ne $value;	3424	return unless $self->{value} ne $value;
3157		3425
3158	$self->_set_value ($value);	3426	$self->_set_value ($value);
3159	$self->_emit (changed => $value);	3427	$self->emit (changed => $value);
3160	}	3428	}
3161		3429
3162	#############################################################################	3430	#############################################################################
3163		3431
3164	package CFClient::UI::Statusbox;	3432	package CFClient::UI::Statusbox;
…		…
3263	$item->{count}++;	3531	$item->{count}++;
3264	} else {	3532	} else {
3265	$item->{count} = 1;	3533	$item->{count} = 1;
3266	$item->{text} = $item->{tooltip} = $text;	3534	$item->{text} = $item->{tooltip} = $text;
3267	}	3535	}
3268	$item->{id} = ++$self->{id};	3536	$item->{id} += 0.2;#d#
3269	$item->{timeout} = $timeout;	3537	$item->{timeout} = $timeout;
3270	delete $item->{label};	3538	delete $item->{label};
3271	} else {	3539	} else {
3272	$self->{item}{$group} = {	3540	$self->{item}{$group} = {
3273	id => ++$self->{id},	3541	id => ++$self->{id},
…		…
3279	count => 1,	3547	count => 1,
3280	%arg,	3548	%arg,
3281	};	3549	};
3282	}	3550	}
3283		3551
		3552	$ROOT->on_refresh (reorder => sub {
3284	$self->reorder;	3553	$self->reorder;
		3554	});
3285	}	3555	}
3286		3556
3287	sub reconfigure {	3557	sub reconfigure {
3288	my ($self) = @_;	3558	my ($self) = @_;
3289		3559
…		…
3292		3562
3293	$self->reorder;	3563	$self->reorder;
3294	$self->SUPER::reconfigure;	3564	$self->SUPER::reconfigure;
3295	}	3565	}
3296		3566
3297	sub DESTROY {	3567	sub destroy {
3298	my ($self) = @_;	3568	my ($self) = @_;
3299		3569
3300	$self->{timer}->cancel;	3570	$self->{timer}->cancel;
3301		3571
3302	$self->SUPER::DESTROY;	3572	$self->SUPER::destroy;
3303	}	3573	}
3304		3574
3305	#############################################################################	3575	#############################################################################
3306		3576
3307	package CFClient::UI::Inventory;	3577	package CFClient::UI::Inventory;
3308		3578
3309	our @ISA = CFClient::UI::ScrolledWindow::;	3579	our @ISA = CFClient::UI::Table::;
3310		3580
3311	sub new {	3581	sub new {
3312	my $class = shift;	3582	my $class = shift;
3313		3583
3314	my $self = $class->SUPER::new (	3584	my $self = $class->SUPER::new (
3315	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),	3585	col_expand => [0, 1, 0],
		3586	items => [],
3316	@_,	3587	@_,
3317	);	3588	);
3318		3589
		3590	$self->set_sort_order (undef);
		3591
3319	$self	3592	$self
		3593	}
		3594
		3595	sub update_items {
		3596	my ($self) = @_;
		3597
		3598	$self->clear;
		3599
		3600	my @item = $self->{sort}->(@{ $self->{items} });
		3601
		3602	my @adds;
		3603	my $row = 0;
		3604	for my $item ($self->{sort}->(@{ $self->{items} })) {
		3605	CFClient::Item::update_widgets $item;
		3606
		3607	push @adds, 0, $row, $item->{face_widget};
		3608	push @adds, 1, $row, $item->{desc_widget};
		3609	push @adds, 2, $row, $item->{weight_widget};
		3610
		3611	$row++;
		3612	}
		3613
		3614	$self->add (@adds);
		3615	}
		3616
		3617	sub set_sort_order {
		3618	my ($self, $order) = @_;
		3619
		3620	$self->{sort} = $order ||= sub {
		3621	sort {
		3622	$a->{type} <=> $b->{type}
		3623	or $a->{name} cmp $b->{name}
		3624	} @_
		3625	};
		3626
		3627	$self->update_items;
3320	}	3628	}
3321		3629
3322	sub set_items {	3630	sub set_items {
3323	my ($self, $items) = @_;	3631	my ($self, $items) = @_;
3324		3632
3325	$self->{child}->clear;	3633	$self->{items} = [$items ? values %$items : ()];
3326	return unless $items;
3327
3328	my @items = sort {
3329	($a->{type} <=> $b->{type})
3330	or ($a->{name} cmp $b->{name})
3331	} @$items;
3332
3333	$self->{real_items} = \@items;
3334
3335	my $row = 0;
3336	for my $item (@items) {
3337	CFClient::Item::update_widgets $item;
3338
3339	$self->{child}->add (0, $row, $item->{face_widget});
3340	$self->{child}->add (1, $row, $item->{desc_widget});
3341	$self->{child}->add (2, $row, $item->{weight_widget});
3342
3343	$row++;
3344	}
3345	}
3346
3347	#############################################################################
3348
3349	package CFClient::UI::BindEditor;
3350
3351	our @ISA = CFClient::UI::FancyFrame::;
3352
3353	sub new {
3354	my $class = shift;
3355
3356	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3357
3358	$self->add (my $vb = new CFClient::UI::VBox);
3359
3360
3361	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3362	text => "start recording",
3363	tooltip => "Start/Stops recording of actions."
3364	."All subsequent actions after the recording started will be captured."
3365	."The actions are displayed after the record was stopped."
3366	."To bind the action you have to click on the 'Bind' button",
3367	on_activate => sub {
3368	unless ($self->{recording}) {
3369	$self->start;
3370	} else {
3371	$self->stop;
3372	}
3373	});
3374
3375	$vb->add (new CFClient::UI::Label text => "Actions:");
3376	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3377
3378	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3379	$vb->add (my $hb = new CFClient::UI::HBox);
3380	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3381	$hb->add (new CFClient::UI::Button
3382	text => "bind",
3383	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3384	on_activate => sub {
3385	$self->ask_for_bind;
3386	});
3387
3388	$vb->add (my $hb = new CFClient::UI::HBox);
3389	$hb->add (new CFClient::UI::Button
3390	text => "ok",
3391	expand => 1,
3392	tooltip => "This closes the binding editor and saves the binding",
3393	on_activate => sub {
3394	$self->hide;
3395	$self->commit;
3396	});
3397
3398	$hb->add (new CFClient::UI::Button
3399	text => "cancel",
3400	expand => 1,
3401	tooltip => "This closes the binding editor without saving",
3402	on_activate => sub {
3403	$self->hide;
3404	$self->{binding_cancel}->()
3405	if $self->{binding_cancel};
3406	});
3407
3408	$self->update_binding_widgets;	3634	$self->update_items;
3409
3410	$self
3411	}
3412
3413	sub commit {
3414	my ($self) = @_;
3415	my ($mod, $sym, $cmds) = $self->get_binding;
3416	if ($sym != 0 && @$cmds > 0) {
3417	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3418	."'. Don't forget 'Save Config'!");
3419	$self->{binding_change}->($mod, $sym, $cmds)
3420	if $self->{binding_change};
3421	} else {
3422	$::STATUSBOX->add ("No action bound, no key or action specified!");
3423	$self->{binding_cancel}->()
3424	if $self->{binding_cancel};
3425	}
3426	}
3427
3428	sub start {
3429	my ($self) = @_;
3430
3431	$self->{rec_btn}->set_text ("stop recording");
3432	$self->{recording} = 1;
3433	$self->clear_command_list;
3434	$::CONN->start_record if $::CONN;
3435	}
3436
3437	sub stop {
3438	my ($self) = @_;
3439
3440	$self->{rec_btn}->set_text ("start recording");
3441	$self->{recording} = 0;
3442
3443	my $rec;
3444	$rec = $::CONN->stop_record if $::CONN;
3445	return unless ref $rec eq 'ARRAY';
3446	$self->set_command_list ($rec);
3447	}
3448
3449
3450	sub ask_for_bind_and_commit {
3451	my ($self) = @_;
3452	$self->ask_for_bind (1);
3453	}
3454
3455	sub ask_for_bind {
3456	my ($self, $commit) = @_;
3457
3458	CFClient::Binder::open_binding_dialog (sub {
3459	my ($mod, $sym) = @_;
3460	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3461	$self->update_binding_widgets;
3462	$self->commit if $commit;
3463	});
3464	}
3465
3466	# $mod and $sym are the modifiers and key symbol
3467	# $cmds is a array ref of strings (the commands)
3468	# $cb is the callback that is executed on OK
3469	# $ccb is the callback that is executed on CANCEL and
3470	# when the binding was unsuccessful on OK
3471	sub set_binding {
3472	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3473
3474	$self->clear_command_list;
3475	$self->{recording} = 0;
3476	$self->{rec_btn}->set_text ("start recording");
3477
3478	$self->{binding} = [$mod, $sym];
3479	$self->{commands} = $cmds;
3480
3481	$self->{binding_change} = $cb;
3482	$self->{binding_cancel} = $ccb;
3483
3484	$self->update_binding_widgets;
3485	}
3486
3487	# this is a shortcut method that asks for a binding
3488	# and then just binds it.
3489	sub do_quick_binding {
3490	my ($self, $cmds) = @_;
3491	$self->set_binding (undef, undef, $cmds, sub {
3492	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3493	});
3494	$self->ask_for_bind (1);
3495	}
3496
3497	sub update_binding_widgets {
3498	my ($self) = @_;
3499	my ($mod, $sym, $cmds) = $self->get_binding;
3500	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3501	$self->set_command_list ($cmds);
3502	}
3503
3504	sub get_binding {
3505	my ($self) = @_;
3506	return (
3507	$self->{binding}->[0],
3508	$self->{binding}->[1],
3509	[ grep { defined $_ } @{$self->{commands}} ]
3510	);
3511	}
3512
3513	sub clear_command_list {
3514	my ($self) = @_;
3515	$self->{cmdbox}->clear ();
3516	}
3517
3518	sub set_command_list {
3519	my ($self, $cmds) = @_;
3520
3521	$self->{cmdbox}->clear ();
3522	$self->{commands} = $cmds;
3523
3524	my $idx = 0;
3525
3526	for (@$cmds) {
3527	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3528
3529	my $i = $idx;
3530	$hb->add (new CFClient::UI::Label text => $_);
3531	$hb->add (new CFClient::UI::Button
3532	text => "delete",
3533	tooltip => "Deletes the action from the record",
3534	on_activate => sub {
3535	$self->{cmdbox}->remove ($hb);
3536	$cmds->[$i] = undef;
3537	});
3538
3539
3540	$idx++
3541	}
3542	}	3635	}
3543		3636
3544	#############################################################################	3637	#############################################################################
3545		3638
3546	package CFClient::UI::SpellList;	3639	package CFClient::UI::SpellList;
…		…
3557	)	3650	)
3558	}	3651	}
3559		3652
3560	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";	3653	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
3561		3654
3562	my @TOOLTIP_NAME = (align => 0, can_events => 1, can_hover => 1, tooltip =>	3655	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3563	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");	3656	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3657	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3658	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
3564	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>	3659	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3565	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");	3660	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
3566	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>	3661	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3567	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");	3662	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
3568	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>	3663	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
…		…
3572	my ($self) = @_;	3667	my ($self) = @_;
3573		3668
3574	$CFClient::UI::ROOT->on_refresh ($self => sub {	3669	$CFClient::UI::ROOT->on_refresh ($self => sub {
3575	$self->clear;	3670	$self->clear;
3576		3671
		3672	return unless $::CONN;
		3673
3577	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);	3674	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3675	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3578	$self->add (2, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);	3676	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3579	$self->add (3, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);	3677	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3580	$self->add (4, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);	3678	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3581		3679
3582	my $row = 0;	3680	my $row = 0;
3583		3681
3584	for (sort { $a cmp $b } keys %{ $self->{spell} }) {	3682	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3585	my $spell = $self->{spell}{$_};	3683	my $spell = $self->{spell}{$_};
…		…
3594	} elsif ($ev->{button} == 2) {	3692	} elsif ($ev->{button} == 2) {
3595	$::CONN->user_send ("invoke $spell->{name}");	3693	$::CONN->user_send ("invoke $spell->{name}");
3596	} elsif ($ev->{button} == 3) {	3694	} elsif ($ev->{button} == 3) {
3597	(new CFClient::UI::Menu	3695	(new CFClient::UI::Menu
3598	items => [	3696	items => [
3599	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],	3697	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3600	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],	3698	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3601	],	3699	],
3602	)->popup ($ev);	3700	)->popup ($ev);
3603	} else {	3701	} else {
3604	return 0;	3702	return 0;
3605	}	3703	}
3606		3704
3607	1	3705	1
3608	};	3706	};
3609		3707
		3708	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3709
		3710	#TODO: add path info to tooltip
		3711	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3712
3610	$self->add (0, $row, new CFClient::UI::Face	3713	$self->add (0, $row, new CFClient::UI::Face
3611	face => $spell->{face},	3714	face => $spell->{face},
3612	can_hover => 1,	3715	can_hover => 1,
3613	can_events => 1,	3716	can_events => 1,
3614	tooltip => $spell->{message},	3717	tooltip => $tooltip,
3615	on_button_down => $spell_cb,	3718	on_button_down => $spell_cb,
3616	);	3719	);
3617		3720
3618	$self->add (1, $row, new CFClient::UI::Label	3721	$self->add (1, $row, new CFClient::UI::Label
3619	expand => 1,	3722	expand => 1,
3620	text => $spell->{name},	3723	text => $spell->{name},
3621	can_hover => 1,	3724	can_hover => 1,
3622	can_events => 1,	3725	can_events => 1,
3623	tooltip => "$spell->{message}$TOOLTIP_ALL",	3726	tooltip => $tooltip,
3624	on_button_down => $spell_cb,	3727	on_button_down => $spell_cb,
3625	);	3728	);
3626		3729
		3730	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
3627	$self->add (2, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);	3731	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3628	$self->add (3, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);	3732	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3629	$self->add (4, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);	3733	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3630	}	3734	}
3631	});	3735	});
3632	}	3736	}
3633		3737
3634	sub add_spell {	3738	sub add_spell {
…		…
3640		3744
3641	sub remove_spell {	3745	sub remove_spell {
3642	my ($self, $spell) = @_;	3746	my ($self, $spell) = @_;
3643		3747
3644	delete $self->{spell}->{$spell->{name}};	3748	delete $self->{spell}->{$spell->{name}};
		3749	$self->rebuild_spell_list;
		3750	}
		3751
		3752	sub clear_spells {
		3753	my ($self) = @_;
		3754
		3755	$self->{spell} = {};
3645	$self->rebuild_spell_list;	3756	$self->rebuild_spell_list;
3646	}	3757	}
3647		3758
3648	#############################################################################	3759	#############################################################################
3649		3760
…		…
3686	$coord = $max - $size if $coord > $max - $size;	3797	$coord = $max - $size if $coord > $max - $size;
3687		3798
3688	int $coord + 0.5	3799	int $coord + 0.5
3689	}	3800	}
3690		3801
3691	sub size_allocate {	3802	sub invoke_size_allocate {
3692	my ($self, $w, $h) = @_;	3803	my ($self, $w, $h) = @_;
3693		3804
3694	for my $child ($self->children) {	3805	for my $child ($self->children) {
3695	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3806	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3696		3807
…		…
3700	$X = _to_pixel $X, $W, $self->{w};	3811	$X = _to_pixel $X, $W, $self->{w};
3701	$Y = _to_pixel $Y, $H, $self->{h};	3812	$Y = _to_pixel $Y, $H, $self->{h};
3702		3813
3703	$child->configure ($X, $Y, $W, $H);	3814	$child->configure ($X, $Y, $W, $H);
3704	}	3815	}
		3816
		3817	1
3705	}	3818	}
3706		3819
3707	sub coord2local {	3820	sub coord2local {
3708	my ($self, $x, $y) = @_;	3821	my ($self, $x, $y) = @_;
3709		3822
…		…
3835	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3948	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3836		3949
3837	$w = 0 if $w < 0;	3950	$w = 0 if $w < 0;
3838	$h = 0 if $h < 0;	3951	$h = 0 if $h < 0;
3839		3952
		3953	$w = max $widget->{min_w}, $w;
		3954	$h = max $widget->{min_h}, $h;
		3955
		3956	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		3957	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		3958
		3959	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3960	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3961
3840	$w = int $w + 0.5;	3962	$w = int $w + 0.5;
3841	$h = int $h + 0.5;	3963	$h = int $h + 0.5;
3842		3964
3843	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	3965	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3844	$widget->{old_w} = $widget->{w};	3966	$widget->{old_w} = $widget->{w};

Diff Legend

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