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.301 by elmex, Mon Jun 12 12:28:06 2006 UTC vs.
Revision 1.330 by root, Sun Jul 23 04:37:51 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	unless ($BUTTON_STATE) {
89	my $widget = $ROOT->find_widget ($x, $y);	102	my $widget = $ROOT->find_widget ($x, $y);
90		103
91	$GRAB = $widget;	104	$GRAB = $widget;
92	$GRAB->update if $GRAB;	105	$GRAB->update if $GRAB;
93		106
94	$TOOLTIP_WATCHER->cb->();	107	$TOOLTIP_WATCHER->cb->();
95	}	108	}
96		109
97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	110	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
98		111
99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	112	if ($GRAB) {
100	if $GRAB;	113	if ($ev->{button} == 4 || $ev->{button} == 5) {
		114	# mousewheel
		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) = @_;
…		…
334	}	355	}
335		356
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";
		360	}
		361
		362	sub baseline_shift {
		363	0
339	}	364	}
340		365
341	sub configure {	366	sub configure {
342	my ($self, $x, $y, $w, $h) = @_;	367	my ($self, $x, $y, $w, $h) = @_;
343		368
…		…
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 {
…		…
418	my ($self, $x, $y) = @_;	439	my ($self, $x, $y) = @_;
419		440
420	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	441	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421	}	442	}
422		443
423	sub focus_in {	444	sub invoke_focus_in {
424	my ($self) = @_;	445	my ($self) = @_;
425		446
426	return if $FOCUS == $self;	447	return if $FOCUS == $self;
427	return unless $self->{can_focus};	448	return unless $self->{can_focus};
428		449
429	my $focus = $FOCUS; $FOCUS = $self;	450	$FOCUS = $self;
430		451
431	$self->_emit (focus_in => $focus);	452	$self->update;
432		453
433	$focus->update if $focus;	454	0
434	$FOCUS->update;
435	}	455	}
436		456
437	sub focus_out {	457	sub invoke_focus_out {
438	my ($self) = @_;	458	my ($self) = @_;
439		459
440	return unless $FOCUS == $self;	460	return unless $FOCUS == $self;
441		461
442	my $focus = $FOCUS; undef $FOCUS;	462	undef $FOCUS;
443		463
444	$self->_emit (focus_out => $focus);	464	$self->update;
445		465
446	$focus->update if $focus; #?
447
448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	466	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449	unless $FOCUS;	467	unless $FOCUS;
450	}
451		468
		469	0
		470	}
		471
		472	sub grab_focus {
		473	my ($self) = @_;
		474
		475	$FOCUS->emit ("focus_out") if $FOCUS;
		476	$self->emit ("focus_in");
		477	}
		478
452	sub mouse_motion { 0 }	479	sub invoke_mouse_motion { 0 }
453	sub button_up { 0 }	480	sub invoke_button_up { 0 }
454	sub key_down { 0 }	481	sub invoke_key_down { 0 }
455	sub key_up { 0 }	482	sub invoke_key_up { 0 }
		483	sub invoke_mouse_wheel { 0 }
456		484
457	sub button_down {	485	sub invoke_button_down {
458	my ($self, $ev, $x, $y) = @_;	486	my ($self, $ev, $x, $y) = @_;
459		487
460	$self->focus_in;	488	$self->grab_focus;
461		489
462	0	490	0
		491	}
		492
		493	sub connect {
		494	my ($self, $signal, $cb) = @_;
		495
		496	push @{ $self->{signal_cb}{$signal} }, $cb;
		497	}
		498
		499	sub emit {
		500	my ($self, $signal, @args) = @_;
		501
		502	my @append
		503	= ref $args[0] && $args[0]->isa ("CFClient::UI::Event")
		504	? $args[0]->xy ($self)
		505	: ();
		506
		507	#warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
		508
		509	#d##TODO# stop propagating at first true, do not use sum
		510	(List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
		511	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append) # closure
		512	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
463	}	513	}
464		514
465	sub find_widget {	515	sub find_widget {
466	my ($self, $x, $y) = @_;	516	my ($self, $x, $y) = @_;
467		517
…		…
477	sub set_parent {	527	sub set_parent {
478	my ($self, $parent) = @_;	528	my ($self, $parent) = @_;
479		529
480	Scalar::Util::weaken ($self->{parent} = $parent);	530	Scalar::Util::weaken ($self->{parent} = $parent);
481	$self->set_visible if $parent->{visible};	531	$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	}	532	}
506		533
507	sub realloc {	534	sub realloc {
508	my ($self) = @_;	535	my ($self) = @_;
509		536
…		…
542	return unless $self->{h} && $self->{w};	569	return unless $self->{h} && $self->{w};
543		570
544	# update screen rectangle	571	# update screen rectangle
545	local $draw_x = $draw_x + $self->{x};	572	local $draw_x = $draw_x + $self->{x};
546	local $draw_y = $draw_y + $self->{y};	573	local $draw_y = $draw_y + $self->{y};
547	local $draw_w = $draw_x + $self->{w};
548	local $draw_h = $draw_y + $self->{h};
549		574
550	# skip widgets that are entirely outside the drawing area	575	# skip widgets that are entirely outside the drawing area
551	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)	576	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
552	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);	577	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
553		578
…		…
592	}	617	}
593		618
594	sub DESTROY {	619	sub DESTROY {
595	my ($self) = @_;	620	my ($self) = @_;
596		621
		622	return if CFClient::in_destruct;
		623
597	delete $WIDGET{$self+0};	624	delete $WIDGET{$self+0};
598	#$self->deactivate;	625
		626	eval { $self->destroy };
		627	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
599	}	628	}
600		629
601	#############################################################################	630	#############################################################################
602		631
603	package CFClient::UI::DrawBG;	632	package CFClient::UI::DrawBG;
…		…
768	}	797	}
769		798
770	sub add {	799	sub add {
771	my ($self, $child) = @_;	800	my ($self, $child) = @_;
772		801
773	$self->{children} = [];	802	$self->SUPER::remove ($_) for @{ $self->{children} };
774
775	$self->SUPER::add ($child);	803	$self->SUPER::add ($child);
776	}	804	}
777		805
778	sub remove {	806	sub remove {
779	my ($self, $widget) = @_;	807	my ($self, $widget) = @_;
…		…
788		816
789	sub size_request {	817	sub size_request {
790	$_[0]{children}[0]->size_request	818	$_[0]{children}[0]->size_request
791	}	819	}
792		820
793	sub size_allocate {	821	sub invoke_size_allocate {
794	my ($self, $w, $h) = @_;	822	my ($self, $w, $h) = @_;
795		823
796	$self->{children}[0]->configure (0, 0, $w, $h);	824	$self->{children}[0]->configure (0, 0, $w, $h);
		825
		826	1
797	}	827	}
798		828
799	#############################################################################	829	#############################################################################
800		830
801	# back-buffered drawing area	831	# back-buffered drawing area
…		…
817		847
818	$ROOT->on_post_alloc ($self => sub { $self->render_child });	848	$ROOT->on_post_alloc ($self => sub { $self->render_child });
819	$self->SUPER::update;	849	$self->SUPER::update;
820	}	850	}
821		851
822	sub size_allocate {	852	sub invoke_size_allocate {
823	my ($self, $w, $h) = @_;	853	my ($self, $w, $h) = @_;
824		854
825	$self->SUPER::size_allocate ($w, $h);
826	$self->update;	855	$self->update;
		856
		857	$self->SUPER::invoke_size_allocate ($w, $h)
827	}	858	}
828		859
829	sub _render {	860	sub _render {
830	my ($self) = @_;	861	my ($self) = @_;
831		862
…		…
892	$h = 10 if $self->{scroll_y};	923	$h = 10 if $self->{scroll_y};
893		924
894	($w, $h)	925	($w, $h)
895	}	926	}
896		927
897	sub size_allocate {	928	sub invoke_size_allocate {
898	my ($self, $w, $h) = @_;	929	my ($self, $w, $h) = @_;
899		930
900	my $child = $self->child;	931	my $child = $self->child;
901		932
902	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};	933	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
903	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};	934	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
904		935
905	$self->child->configure (0, 0, $w, $h);	936	$self->child->configure (0, 0, $w, $h);
906	$self->update;	937	$self->update;
		938
		939	1
907	}	940	}
908		941
909	sub set_offset {	942	sub set_offset {
910	my ($self, $x, $y) = @_;	943	my ($self, $x, $y) = @_;
911		944
…		…
974	$self->{vp}->set_offset (0, $_[1]);	1007	$self->{vp}->set_offset (0, $_[1]);
975	},	1008	},
976	;	1009	;
977		1010
978	$self = $class->SUPER::new (	1011	$self = $class->SUPER::new (
979	vp => (new CFClient::UI::ViewPort expand => 1),	1012	vp => (new CFClient::UI::ViewPort expand => 1),
		1013	can_events => 1,
980	slider => $slider,	1014	slider => $slider,
981	%arg,	1015	%arg,
982	);	1016	);
983		1017
984	$self->SUPER::add ($self->{vp}, $self->{slider});	1018	$self->SUPER::add ($self->{vp}, $self->{slider});
985	$self->add ($child) if $child;	1019	$self->add ($child) if $child;
986		1020
987	$self	1021	$self
988	}	1022	}
989		1023
		1024	#TODO# update range on size_allocate depending on child
		1025
990	sub add {	1026	sub add {
991	my ($self, $widget) = @_;	1027	my ($self, $widget) = @_;
992		1028
993	$self->{vp}->add ($self->{child} = $widget);	1029	$self->{vp}->add ($self->{child} = $widget);
994	}	1030	}
995		1031
		1032	sub invoke_mouse_wheel {
		1033	my ($self, $ev) = @_;
		1034
		1035	return 0 unless $ev->{dy}; # only vertical movements
		1036
		1037	$self->{slider}->emit (mouse_wheel => $ev);
		1038
		1039	1
		1040	}
		1041
		1042	sub update_slider {
		1043	my ($self) = @_;
		1044
		1045	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
		1046	}
		1047
996	sub update {	1048	sub update {
997	my ($self) = @_;	1049	my ($self) = @_;
998		1050
999	$self->SUPER::update;	1051	$self->SUPER::update;
1000		1052
1001	# todo: overwrite size_allocate of child	1053	$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	}	1054	}
1005		1055
1006	sub size_allocate {	1056	sub invoke_size_allocate {
1007	my ($self, $w, $h) = @_;	1057	my ($self, $w, $h) = @_;
1008		1058
		1059	$self->update_slider;
		1060
1009	$self->SUPER::size_allocate ($w, $h);	1061	$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	}	1062	}
1014
1015	#TODO# update range on size_allocate depending on child
1016	# update viewport offset on scroll
1017		1063
1018	#############################################################################	1064	#############################################################################
1019		1065
1020	package CFClient::UI::Frame;	1066	package CFClient::UI::Frame;
1021		1067
…		…
1072	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1118	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1073		1119
1074	sub new {	1120	sub new {
1075	my ($class, %arg) = @_;	1121	my ($class, %arg) = @_;
1076		1122
1077	my $title = delete $arg{title};
1078
1079	my $self = $class->SUPER::new (	1123	my $self = $class->SUPER::new (
1080	bg => [1, 1, 1, 1],	1124	bg => [1, 1, 1, 1],
1081	border_bg => [1, 1, 1, 1],	1125	border_bg => [1, 1, 1, 1],
1082	border => 0.6,	1126	border => 0.6,
1083	can_events => 1,	1127	can_events => 1,
1084	min_w => 16,	1128	min_w => 64,
1085	min_h => 16,	1129	min_h => 32,
1086	%arg,	1130	%arg,
1087	);	1131	);
1088		1132
1089	$self->{title} = new CFClient::UI::Label	1133	$self->{title_widget} = new CFClient::UI::Label
1090	align => 0,	1134	align => 0,
1091	valign => 1,	1135	valign => 1,
1092	text => $title,	1136	text => $self->{title},
1093	fontsize => $self->{border}	1137	fontsize => $self->{border},
1094	if defined $title;	1138	if exists $self->{title};
		1139
		1140	if ($self->{has_close_button}) {
		1141	$self->{close_button} =
		1142	new CFClient::UI::ImageButton
		1143	path => 'x1_close.png',
		1144	on_activate => sub { $self->emit ("delete") };
		1145
		1146	$self->CFClient::UI::Container::add ($self->{close_button});
		1147	}
1095		1148
1096	$self	1149	$self
1097	}	1150	}
1098		1151
1099	sub add {	1152	sub add {
1100	my ($self, @widgets) = @_;	1153	my ($self, @widgets) = @_;
1101		1154
1102	$self->SUPER::add (@widgets);	1155	$self->SUPER::add (@widgets);
		1156	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1103	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};	1157	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1104	}	1158	}
1105		1159
1106	sub border {	1160	sub border {
1107	int $_[0]{border} * $::FONTSIZE	1161	int $_[0]{border} * $::FONTSIZE
1108	}	1162	}
1109		1163
1110	sub size_request {	1164	sub size_request {
1111	my ($self) = @_;	1165	my ($self) = @_;
1112		1166
1113	$self->{title}->size_request	1167	$self->{title_widget}->size_request
1114	if $self->{title};	1168	if $self->{title_widget};
		1169
		1170	$self->{close_button}->size_request
		1171	if $self->{close_button};
1115		1172
1116	my ($w, $h) = $self->SUPER::size_request;	1173	my ($w, $h) = $self->SUPER::size_request;
1117		1174
1118	(	1175	(
1119	$w + $self->border * 2,	1176	$w + $self->border * 2,
1120	$h + $self->border * 2,	1177	$h + $self->border * 2,
1121	)	1178	)
1122	}	1179	}
1123		1180
1124	sub size_allocate {	1181	sub invoke_size_allocate {
1125	my ($self, $w, $h) = @_;	1182	my ($self, $w, $h) = @_;
1126		1183
1127	if ($self->{title}) {	1184	if ($self->{title_widget}) {
1128	$self->{title}{w} = $w;	1185	$self->{title_widget}{w} = $w;
1129	$self->{title}{h} = $h;	1186	$self->{title_widget}{h} = $h;
1130	$self->{title}->size_allocate ($w, $h);	1187	$self->{title_widget}->invoke_size_allocate ($w, $h);
1131	}	1188	}
1132		1189
1133	my $border = $self->border;	1190	my $border = $self->border;
1134		1191
1135	$h -= List::Util::max 0, $border * 2;	1192	$h -= List::Util::max 0, $border * 2;
1136	$w -= List::Util::max 0, $border * 2;	1193	$w -= List::Util::max 0, $border * 2;
		1194
		1195	$self->child->configure ($border, $border, $w, $h);
		1196
		1197	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1198	if $self->{close_button};
		1199
		1200	1
		1201	}
		1202
		1203	sub invoke_delete {
		1204	my ($self) = @_;
		1205
		1206	$self->hide;
1137		1207
1138	$self->child->configure ($border, $border, $w, $h);	1208	1
1139	}	1209	}
1140		1210
1141	sub button_down {	1211	sub invoke_button_down {
1142	my ($self, $ev, $x, $y) = @_;	1212	my ($self, $ev, $x, $y) = @_;
1143		1213
1144	my ($w, $h) = @$self{qw(w h)};	1214	my ($w, $h) = @$self{qw(w h)};
1145	my $border = $self->border;	1215	my $border = $self->border;
1146		1216
…		…
1177		1247
1178	($x, $y) = ($ev->{x}, $ev->{y});	1248	($x, $y) = ($ev->{x}, $ev->{y});
1179		1249
1180	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1250	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1181	# HACK: the next line is required to enforce placement	1251	# HACK: the next line is required to enforce placement
1182	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1252	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1183	};	1253	};
1184	} else {	1254	} else {
1185	return 0;	1255	return 0;
1186	}	1256	}
1187		1257
1188	1	1258	1
1189	}	1259	}
1190		1260
1191	sub button_up {	1261	sub invoke_button_up {
1192	my ($self, $ev, $x, $y) = @_;	1262	my ($self, $ev, $x, $y) = @_;
1193		1263
1194	!!delete $self->{motion}	1264	! ! delete $self->{motion}
1195	}	1265	}
1196		1266
1197	sub mouse_motion {	1267	sub invoke_mouse_motion {
1198	my ($self, $ev, $x, $y) = @_;	1268	my ($self, $ev, $x, $y) = @_;
1199		1269
1200	$self->{motion}->($ev, $x, $y) if $self->{motion};	1270	$self->{motion}->($ev, $x, $y) if $self->{motion};
1201		1271
1202	!!$self->{motion}	1272	! ! $self->{motion}
1203	}	1273	}
1204		1274
1205	sub _draw {	1275	sub _draw {
1206	my ($self) = @_;	1276	my ($self) = @_;
1207		1277
…		…
1233		1303
1234	glDisable GL_TEXTURE_2D;	1304	glDisable GL_TEXTURE_2D;
1235		1305
1236	$child->draw;	1306	$child->draw;
1237		1307
1238	if ($self->{title}) {	1308	if ($self->{title_widget}) {
1239	glTranslate 0, $border - $self->{h};	1309	glTranslate 0, $border - $self->{h};
1240	$self->{title}->_draw;	1310	$self->{title_widget}->_draw;
		1311
		1312	glTranslate 0, - ($border - $self->{h});
1241	}	1313	}
		1314
		1315	$self->{close_button}->draw
		1316	if $self->{close_button};
1242	}	1317	}
1243		1318
1244	#############################################################################	1319	#############################################################################
1245		1320
1246	package CFClient::UI::Table;	1321	package CFClient::UI::Table;
…		…
1269		1344
1270	$child->set_parent ($self);	1345	$child->set_parent ($self);
1271	$self->{children}[$y][$x] = $child;	1346	$self->{children}[$y][$x] = $child;
1272		1347
1273	$self->realloc;	1348	$self->realloc;
		1349	}
		1350
		1351	sub remove {
		1352	my ($self, $child) = @_;
		1353
		1354	# TODO: not yet implemented
1274	}	1355	}
1275		1356
1276	# TODO: move to container class maybe? send children a signal on removal?	1357	# TODO: move to container class maybe? send children a signal on removal?
1277	sub clear {	1358	sub clear {
1278	my ($self) = @_;	1359	my ($self) = @_;
…		…
1319	(sum @$ws),	1400	(sum @$ws),
1320	(sum @$hs),	1401	(sum @$hs),
1321	)	1402	)
1322	}	1403	}
1323		1404
1324	sub size_allocate {	1405	sub invoke_size_allocate {
1325	my ($self, $w, $h) = @_;	1406	my ($self, $w, $h) = @_;
1326		1407
1327	my ($ws, $hs) = $self->get_wh;	1408	my ($ws, $hs) = $self->get_wh;
1328		1409
1329	my $req_w = (sum @$ws) || 1;	1410	my $req_w = (sum @$ws) || 1;
…		…
1361	}	1442	}
1362		1443
1363	$y += $row_h;	1444	$y += $row_h;
1364	}	1445	}
1365		1446
		1447	1
1366	}	1448	}
1367		1449
1368	sub find_widget {	1450	sub find_widget {
1369	my ($self, $x, $y) = @_;	1451	my ($self, $x, $y) = @_;
1370		1452
…		…
1407	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1489	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1408	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1490	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1409	)	1491	)
1410	}	1492	}
1411		1493
1412	sub size_allocate {	1494	sub invoke_size_allocate {
1413	my ($self, $w, $h) = @_;	1495	my ($self, $w, $h) = @_;
1414		1496
1415	my $space = $self->{vertical} ? $h : $w;	1497	my $space = $self->{vertical} ? $h : $w;
1416	my $children = $self->{children};	1498	my @children = $self->visible_children;
1417		1499
1418	my @req;	1500	my @req;
1419		1501
1420	if ($self->{homogeneous}) {	1502	if ($self->{homogeneous}) {
1421	@req = ($space / (@$children || 1)) x @$children;	1503	@req = ($space / (@children || 1)) x @children;
1422	} else {	1504	} else {
1423	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1505	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1424	my $req = List::Util::sum @req;	1506	my $req = List::Util::sum @req;
1425		1507
1426	if ($req > $space) {	1508	if ($req > $space) {
1427	# ah well, not enough space	1509	# ah well, not enough space
1428	$_ *= $space / $req for @req;	1510	$_ *= $space / $req for @req;
1429	} else {	1511	} else {
1430	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1512	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1431		1513
1432	$space = ($space - $req) / $expand; # remaining space to give away	1514	$space = ($space - $req) / $expand; # remaining space to give away
1433		1515
1434	$req[$_] += $space * $children->[$_]{expand}	1516	$req[$_] += $space * $children[$_]{expand}
1435	for 0 .. $#$children;	1517	for 0 .. $#children;
1436	}	1518	}
1437	}	1519	}
1438		1520
1439	CFClient::UI::harmonize \@req;	1521	CFClient::UI::harmonize \@req;
1440		1522
1441	my $pos = 0;	1523	my $pos = 0;
1442	for (0 .. $#$children) {	1524	for (0 .. $#children) {
1443	my $alloc = $req[$_];	1525	my $alloc = $req[$_];
1444	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1526	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1445		1527
1446	$pos += $alloc;	1528	$pos += $alloc;
1447	}	1529	}
1448		1530
1449	1	1531	1
…		…
1552	my ($self, $text) = @_;	1634	my ($self, $text) = @_;
1553		1635
1554	return if $self->{text} eq "T$text";	1636	return if $self->{text} eq "T$text";
1555	$self->{text} = "T$text";	1637	$self->{text} = "T$text";
1556		1638
1557	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1558	$self->{layout}->set_text ($text);	1639	$self->{layout}->set_text ($text);
1559		1640
1560	delete $self->{size_req};	1641	delete $self->{size_req};
1561	$self->realloc;	1642	$self->realloc;
1562	$self->update;	1643	$self->update;
…		…
1568	return if $self->{text} eq "M$markup";	1649	return if $self->{text} eq "M$markup";
1569	$self->{text} = "M$markup";	1650	$self->{text} = "M$markup";
1570		1651
1571	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1652	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1572		1653
1573	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1574	$self->{layout}->set_markup ($markup);	1654	$self->{layout}->set_markup ($markup);
1575		1655
1576	delete $self->{size_req};	1656	delete $self->{size_req};
1577	$self->realloc;	1657	$self->realloc;
1578	$self->update;	1658	$self->update;
…		…
1590		1670
1591	my ($w, $h) = $self->{layout}->size;	1671	my ($w, $h) = $self->{layout}->size;
1592		1672
1593	if (exists $self->{template}) {	1673	if (exists $self->{template}) {
1594	$self->{template}->set_font ($self->{font}) if $self->{font};	1674	$self->{template}->set_font ($self->{font}) if $self->{font};
		1675	$self->{template}->set_width ($self->{max_w} || -1);
1595	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1676	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1596		1677
1597	my ($w2, $h2) = $self->{template}->size;	1678	my ($w2, $h2) = $self->{template}->size;
1598		1679
1599	$w = List::Util::max $w, $w2;	1680	$w = List::Util::max $w, $w2;
…		…
1604	};	1685	};
1605		1686
1606	@{ $self->{size_req} }	1687	@{ $self->{size_req} }
1607	}	1688	}
1608		1689
		1690	sub baseline_shift {
		1691	$_[0]{layout}->descent
		1692	}
		1693
1609	sub size_allocate {	1694	sub invoke_size_allocate {
1610	my ($self, $w, $h) = @_;	1695	my ($self, $w, $h) = @_;
1611		1696
1612	delete $self->{ox};	1697	delete $self->{ox};
1613		1698
1614	delete $self->{texture}	1699	delete $self->{texture}
1615	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};	1700	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1701
		1702	1
1616	}	1703	}
1617		1704
1618	sub set_fontsize {	1705	sub set_fontsize {
1619	my ($self, $fontsize) = @_;	1706	my ($self, $fontsize) = @_;
1620		1707
1621	$self->{fontsize} = $fontsize;	1708	$self->{fontsize} = $fontsize;
		1709	delete $self->{size_req};
1622	delete $self->{texture};	1710	delete $self->{texture};
1623		1711
1624	$self->realloc;	1712	$self->realloc;
1625	}	1713	}
1626		1714
1627	sub reconfigure {	1715	sub reconfigure {
1628	my ($self) = @_;	1716	my ($self) = @_;
1629		1717
1630	delete $self->{size_req};	1718	delete $self->{size_req};
		1719	delete $self->{texture};
1631		1720
1632	$self->SUPER::reconfigure;	1721	$self->SUPER::reconfigure;
1633	}	1722	}
1634		1723
1635	sub _draw {	1724	sub _draw {
1636	my ($self) = @_;	1725	my ($self) = @_;
1637		1726
1638	$self->SUPER::_draw; # draw background, if applicable	1727	$self->SUPER::_draw; # draw background, if applicable
1639		1728
1640	my $tex = $self->{texture} ||= do {	1729	my $size = $self->{texture} ||= do {
1641	$self->{layout}->set_foreground (@{$self->{fg}});	1730	$self->{layout}->set_foreground (@{$self->{fg}});
1642	$self->{layout}->set_font ($self->{font}) if $self->{font};	1731	$self->{layout}->set_font ($self->{font}) if $self->{font};
1643	$self->{layout}->set_width ($self->{w});	1732	$self->{layout}->set_width ($self->{w});
1644	$self->{layout}->set_ellipsise ($self->{ellipsise});	1733	$self->{layout}->set_ellipsise ($self->{ellipsise});
1645	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1734	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1646	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1735	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1647		1736
1648	new_from_layout CFClient::Texture $self->{layout}	1737	[$self->{layout}->size]
1649	};	1738	};
1650		1739
1651	unless (exists $self->{ox}) {	1740	unless (exists $self->{ox}) {
1652	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1741	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1653	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1742	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1654	: ($self->{w} - $tex->{w}) * 0.5);	1743	: ($self->{w} - $size->[0]) * 0.5);
1655		1744
1656	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1745	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1657	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1746	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1658	: ($self->{h} - $tex->{h}) * 0.5);	1747	: ($self->{h} - $size->[1]) * 0.5);
1659	};	1748	};
1660		1749
1661	glEnable GL_TEXTURE_2D;
1662
1663	my $w = List::Util::min $self->{w} + 4, $tex->{w};	1750	my $w = List::Util::min $self->{w} + 4, $size->[0];
1664	my $h = List::Util::min $self->{h} + 2, $tex->{h};	1751	my $h = List::Util::min $self->{h} + 2, $size->[1];
1665		1752
1666	if ($tex->{format} == GL_ALPHA) {	1753	$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	}	1754	}
1677		1755
1678	#############################################################################	1756	#############################################################################
1679		1757
1680	package CFClient::UI::EntryBase;	1758	package CFClient::UI::EntryBase;
…		…
1713		1791
1714	$text =~ s/./*/g if $self->{hidden};	1792	$text =~ s/./*/g if $self->{hidden};
1715	$self->{layout}->set_text ("$text ");	1793	$self->{layout}->set_text ("$text ");
1716	delete $self->{size_req};	1794	delete $self->{size_req};
1717		1795
1718	$self->_emit (changed => $self->{text});	1796	$self->emit (changed => $self->{text});
1719		1797
1720	$self->realloc;	1798	$self->realloc;
1721	$self->update;	1799	$self->update;
1722	}	1800	}
1723		1801
…		…
1738	my ($w, $h) = $self->SUPER::size_request;	1816	my ($w, $h) = $self->SUPER::size_request;
1739		1817
1740	($w + 1, $h) # add 1 for cursor	1818	($w + 1, $h) # add 1 for cursor
1741	}	1819	}
1742		1820
1743	sub key_down {	1821	sub invoke_key_down {
1744	my ($self, $ev) = @_;	1822	my ($self, $ev) = @_;
1745		1823
1746	my $mod = $ev->{mod};	1824	my $mod = $ev->{mod};
1747	my $sym = $ev->{sym};	1825	my $sym = $ev->{sym};
1748	my $uni = $ev->{unicode};	1826	my $uni = $ev->{unicode};
…		…
1760	} elsif ($sym == CFClient::SDLK_HOME) {	1838	} elsif ($sym == CFClient::SDLK_HOME) {
1761	$self->{cursor} = 0;	1839	$self->{cursor} = 0;
1762	} elsif ($sym == CFClient::SDLK_END) {	1840	} elsif ($sym == CFClient::SDLK_END) {
1763	$self->{cursor} = length $text;	1841	$self->{cursor} = length $text;
1764	} elsif ($uni == 27) {	1842	} elsif ($uni == 27) {
1765	$self->_emit ('escape');	1843	$self->emit ('escape');
1766	} elsif ($uni) {	1844	} elsif ($uni) {
1767	substr $text, $self->{cursor}++, 0, chr $uni;	1845	substr $text, $self->{cursor}++, 0, chr $uni;
1768	} else {	1846	} else {
1769	return 0;	1847	return 0;
1770	}	1848	}
…		…
1774	$self->realloc;	1852	$self->realloc;
1775		1853
1776	1	1854	1
1777	}	1855	}
1778		1856
1779	sub focus_in {	1857	sub invoke_focus_in {
1780	my ($self) = @_;	1858	my ($self) = @_;
1781		1859
1782	$self->{last_activity} = $::NOW;	1860	$self->{last_activity} = $::NOW;
1783		1861
1784	$self->SUPER::focus_in;	1862	$self->SUPER::invoke_focus_in
1785	}	1863	}
1786		1864
1787	sub button_down {	1865	sub invoke_button_down {
1788	my ($self, $ev, $x, $y) = @_;	1866	my ($self, $ev, $x, $y) = @_;
1789		1867
1790	$self->SUPER::button_down ($ev, $x, $y);	1868	$self->SUPER::invoke_button_down ($ev, $x, $y);
1791		1869
1792	my $idx = $self->{layout}->xy_to_index ($x, $y);	1870	my $idx = $self->{layout}->xy_to_index ($x, $y);
1793		1871
1794	# byte-index to char-index	1872	# byte-index to char-index
1795	my $text = $self->{text};	1873	my $text = $self->{text};
1796	utf8::encode $text;	1874	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1797	$self->{cursor} = length substr $text, 0, $idx;	1875	$self->{cursor} = length $text;
1798		1876
1799	$self->_set_text ($self->{text});	1877	$self->_set_text ($self->{text});
1800	$self->update;	1878	$self->update;
1801		1879
1802	1	1880	1
1803	}	1881	}
1804		1882
1805	sub mouse_motion {	1883	sub invoke_mouse_motion {
1806	my ($self, $ev, $x, $y) = @_;	1884	my ($self, $ev, $x, $y) = @_;
1807	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1885	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1808		1886
1809	0	1887	1
1810	}	1888	}
1811		1889
1812	sub _draw {	1890	sub _draw {
1813	my ($self) = @_;	1891	my ($self) = @_;
1814		1892
…		…
1855		1933
1856	our @ISA = CFClient::UI::EntryBase::;	1934	our @ISA = CFClient::UI::EntryBase::;
1857		1935
1858	use CFClient::OpenGL;	1936	use CFClient::OpenGL;
1859		1937
1860	sub key_down {	1938	sub invoke_key_down {
1861	my ($self, $ev) = @_;	1939	my ($self, $ev) = @_;
1862		1940
1863	my $sym = $ev->{sym};	1941	my $sym = $ev->{sym};
1864		1942
1865	if ($sym == 13) {	1943	if ($sym == 13) {
1866	unshift @{$self->{history}},	1944	unshift @{$self->{history}},
1867	my $txt = $self->get_text;	1945	my $txt = $self->get_text;
		1946
1868	$self->{history_pointer} = -1;	1947	$self->{history_pointer} = -1;
1869	$self->{history_saveback} = '';	1948	$self->{history_saveback} = '';
1870	$self->_emit (activate => $txt);	1949	$self->emit (activate => $txt);
1871	$self->update;	1950	$self->update;
1872		1951
1873	} elsif ($sym == CFClient::SDLK_UP) {	1952	} elsif ($sym == CFClient::SDLK_UP) {
1874	if ($self->{history_pointer} < 0) {	1953	if ($self->{history_pointer} < 0) {
1875	$self->{history_saveback} = $self->get_text;	1954	$self->{history_saveback} = $self->get_text;
…		…
1891	} else {	1970	} else {
1892	$self->set_text ($self->{history_saveback});	1971	$self->set_text ($self->{history_saveback});
1893	}	1972	}
1894		1973
1895	} else {	1974	} else {
1896	return $self->SUPER::key_down ($ev)	1975	return $self->SUPER::invoke_key_down ($ev)
1897	}	1976	}
1898		1977
1899	1	1978	1
1900	}	1979	}
1901		1980
…		…
1925	can_events => 1,	2004	can_events => 1,
1926	@_	2005	@_
1927	)	2006	)
1928	}	2007	}
1929		2008
1930	sub activate { }
1931
1932	sub button_up {	2009	sub invoke_button_up {
1933	my ($self, $ev, $x, $y) = @_;	2010	my ($self, $ev, $x, $y) = @_;
1934		2011
1935	$self->emit ("activate")	2012	$self->emit ("activate")
1936	if $x >= 0 && $x < $self->{w}	2013	if $x >= 0 && $x < $self->{w}
1937	&& $y >= 0 && $y < $self->{h};	2014	&& $y >= 0 && $y < $self->{h};
…		…
1951	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2028	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1952		2029
1953	glDisable GL_TEXTURE_2D;	2030	glDisable GL_TEXTURE_2D;
1954		2031
1955	$self->SUPER::_draw;	2032	$self->SUPER::_draw;
		2033	}
		2034
		2035	#############################################################################
		2036
		2037	package CFClient::UI::ImageButton;
		2038
		2039	our @ISA = CFClient::UI::Image::;
		2040
		2041	use CFClient::OpenGL;
		2042
		2043	my %textures;
		2044
		2045	sub new {
		2046	my $class = shift;
		2047
		2048	my $self = $class->SUPER::new (
		2049	padding_x => 4,
		2050	padding_y => 4,
		2051	fg => [1, 1, 1],
		2052	active_fg => [0, 0, 1],
		2053	can_hover => 1,
		2054	align => 0,
		2055	valign => 0,
		2056	can_events => 1,
		2057	@_
		2058	);
		2059	}
		2060
		2061	sub invoke_button_up {
		2062	my ($self, $ev, $x, $y) = @_;
		2063
		2064	$self->emit ("activate")
		2065	if $x >= 0 && $x < $self->{w}
		2066	&& $y >= 0 && $y < $self->{h};
		2067
		2068	1
1956	}	2069	}
1957		2070
1958	#############################################################################	2071	#############################################################################
1959		2072
1960	package CFClient::UI::CheckBox;	2073	package CFClient::UI::CheckBox;
…		…
1987	my ($self) = @_;	2100	my ($self) = @_;
1988		2101
1989	(6) x 2	2102	(6) x 2
1990	}	2103	}
1991		2104
		2105	sub toggle {
		2106	my ($self) = @_;
		2107
		2108	$self->{state} = !$self->{state};
		2109	$self->emit (changed => $self->{state});
		2110	$self->update;
		2111	}
		2112
1992	sub button_down {	2113	sub invoke_button_down {
1993	my ($self, $ev, $x, $y) = @_;	2114	my ($self, $ev, $x, $y) = @_;
1994		2115
1995	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2116	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1996	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2117	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1997	$self->{state} = !$self->{state};	2118	$self->toggle;
1998	$self->_emit (changed => $self->{state});
1999	} else {	2119	} else {
2000	return 0	2120	return 0
2001	}	2121	}
2002		2122
2003	1	2123	1
…		…
2028	package CFClient::UI::Image;	2148	package CFClient::UI::Image;
2029		2149
2030	our @ISA = CFClient::UI::Base::;	2150	our @ISA = CFClient::UI::Base::;
2031		2151
2032	use CFClient::OpenGL;	2152	use CFClient::OpenGL;
2033	use Carp qw/confess/;
2034		2153
2035	our %loaded_images;	2154	our %texture_cache;
2036		2155
2037	sub new {	2156	sub new {
2038	my $class = shift;	2157	my $class = shift;
2039		2158
2040	my $self = $class->SUPER::new (can_events => 0, @_);	2159	my $self = $class->SUPER::new (
		2160	can_events => 0,
		2161	@_,
		2162	);
2041		2163
2042	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2164	$self->{path} || $self->{tex}
		2165	or Carp::croak "'path' or 'tex' attributes required";
2043		2166
2044	$loaded_images{$self->{image}} ||=	2167	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2045	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2168	new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2046		2169
2047	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2170	Scalar::Util::weaken $texture_cache{$self->{path}};
2048		2171
2049	Scalar::Util::weaken $loaded_images{$self->{image}};	2172	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2050
2051	$self->{aspect} = $tex->{w} / $tex->{h};
2052		2173
2053	$self	2174	$self
2054	}	2175	}
2055		2176
2056	sub size_request {	2177	sub size_request {
2057	my ($self) = @_;	2178	my ($self) = @_;
2058		2179
2059	($self->{tex}->{w}, $self->{tex}->{h})	2180	($self->{tex}{w}, $self->{tex}{h})
2060	}	2181	}
2061		2182
2062	sub _draw {	2183	sub _draw {
2063	my ($self) = @_;	2184	my ($self) = @_;
2064		2185
…		…
2173	my $ycut1 = max 0, min 1, $ycut;	2294	my $ycut1 = max 0, min 1, $ycut;
2174	my $ycut2 = max 0, min 1, $ycut - 1;	2295	my $ycut2 = max 0, min 1, $ycut - 1;
2175		2296
2176	my $h1 = $self->{h} * (1 - $ycut1);	2297	my $h1 = $self->{h} * (1 - $ycut1);
2177	my $h2 = $self->{h} * (1 - $ycut2);	2298	my $h2 = $self->{h} * (1 - $ycut2);
		2299	my $h3 = $self->{h};
		2300
		2301	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2178		2302
2179	glEnable GL_BLEND;	2303	glEnable GL_BLEND;
2180	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2304	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2181	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2305	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2182	glEnable GL_TEXTURE_2D;	2306	glEnable GL_TEXTURE_2D;
…		…
2201		2325
2202	if ($t3) {	2326	if ($t3) {
2203	glBindTexture GL_TEXTURE_2D, $t3->{name};	2327	glBindTexture GL_TEXTURE_2D, $t3->{name};
2204	glBegin GL_QUADS;	2328	glBegin GL_QUADS;
2205	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2329	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2206	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2330	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2207	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2331	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2208	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2332	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2209	glEnd;	2333	glEnd;
2210	}	2334	}
2211		2335
2212	glDisable GL_BLEND;	2336	glDisable GL_BLEND;
…		…
2300	$self->update;	2424	$self->update;
2301		2425
2302	$self	2426	$self
2303	}	2427	}
2304		2428
2305	sub changed { }
2306
2307	sub set_range {	2429	sub set_range {
2308	my ($self, $range) = @_;	2430	my ($self, $range) = @_;
2309		2431
2310	($range, $self->{range}) = ($self->{range}, $range);	2432	($range, $self->{range}) = ($self->{range}, $range);
2311		2433
…		…
2331	if $unit;	2453	if $unit;
2332		2454
2333	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2455	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2334		2456
2335	if ($value != $old_value) {	2457	if ($value != $old_value) {
2336	$self->_emit (changed => $value);	2458	$self->emit (changed => $value);
2337	$self->update;	2459	$self->update;
2338	}	2460	}
2339	}	2461	}
2340		2462
2341	sub size_request {	2463	sub size_request {
2342	my ($self) = @_;	2464	my ($self) = @_;
2343		2465
2344	($self->{req_w}, $self->{req_h})	2466	($self->{req_w}, $self->{req_h})
2345	}	2467	}
2346		2468
2347	sub button_down {	2469	sub invoke_button_down {
2348	my ($self, $ev, $x, $y) = @_;	2470	my ($self, $ev, $x, $y) = @_;
2349		2471
2350	$self->SUPER::button_down ($ev, $x, $y);	2472	$self->SUPER::invoke_button_down ($ev, $x, $y);
2351		2473
2352	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2474	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2353		2475
2354	$self->mouse_motion ($ev, $x, $y)	2476	$self->invoke_mouse_motion ($ev, $x, $y)
2355	}	2477	}
2356		2478
2357	sub mouse_motion {	2479	sub invoke_mouse_motion {
2358	my ($self, $ev, $x, $y) = @_;	2480	my ($self, $ev, $x, $y) = @_;
2359		2481
2360	if ($GRAB == $self) {	2482	if ($GRAB == $self) {
2361	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2483	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2362		2484
…		…
2368	} else {	2490	} else {
2369	return 0;	2491	return 0;
2370	}	2492	}
2371		2493
2372	1	2494	1
		2495	}
		2496
		2497	sub invoke_mouse_wheel {
		2498	my ($self, $ev) = @_;
		2499
		2500	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2501
		2502	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.1);
		2503
		2504	! ! $delta
2373	}	2505	}
2374		2506
2375	sub update {	2507	sub update {
2376	my ($self) = @_;	2508	my ($self) = @_;
2377		2509
…		…
2478	sub new {	2610	sub new {
2479	my $class = shift;	2611	my $class = shift;
2480		2612
2481	my $self = $class->SUPER::new (	2613	my $self = $class->SUPER::new (
2482	fontsize => 1,	2614	fontsize => 1,
2483	can_events => 0,	2615	can_events => 1,
2484	indent => 0,	2616	indent => 0,
2485	#font => default_font	2617	#font => default_font
2486	@_,	2618	@_,
2487		2619
2488	layout => (new CFClient::Layout 1),	2620	layout => (new CFClient::Layout),
2489	par => [],	2621	par => [],
2490	height => 0,	2622	height => 0,
2491	children => [	2623	children => [
2492	(new CFClient::UI::Empty expand => 1),	2624	(new CFClient::UI::Empty expand => 1),
2493	(new CFClient::UI::Slider vertical => 1),	2625	(new CFClient::UI::Slider vertical => 1),
…		…
2504		2636
2505	$self->{fontsize} = $fontsize;	2637	$self->{fontsize} = $fontsize;
2506	$self->reflow;	2638	$self->reflow;
2507	}	2639	}
2508		2640
		2641	sub size_request {
		2642	my ($self) = @_;
		2643
		2644	my ($empty, $slider) = @{ $self->{children} };
		2645
		2646	local $self->{children} = [$empty, $slider];
		2647	$self->SUPER::size_request
		2648	}
		2649
2509	sub size_allocate {	2650	sub invoke_size_allocate {
2510	my ($self, $w, $h) = @_;	2651	my ($self, $w, $h) = @_;
2511		2652
2512	$self->SUPER::size_allocate ($w, $h);	2653	my ($empty, $slider, @other) = @{ $self->{children} };
		2654	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2513		2655
2514	$self->{layout}->set_font ($self->{font}) if $self->{font};	2656	$self->{layout}->set_font ($self->{font}) if $self->{font};
2515	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2657	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2516	$self->{layout}->set_width ($self->{children}[0]{w});	2658	$self->{layout}->set_width ($empty->{w});
2517	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2659	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2518		2660
2519	$self->reflow;	2661	$self->reflow;
2520	}
2521		2662
2522	sub text_size {	2663	local $self->{children} = [$empty, $slider];
		2664	$self->SUPER::invoke_size_allocate ($w, $h)
		2665	}
		2666
		2667	sub invoke_mouse_wheel {
2523	my ($self, $text, $indent) = @_;	2668	my ($self, $ev) = @_;
		2669
		2670	return 0 unless $ev->{dy}; # only vertical movements
		2671
		2672	$self->{children}[1]->emit (mouse_wheel => $ev);
		2673
		2674	1
		2675	}
		2676
		2677	sub get_layout {
		2678	my ($self, $para) = @_;
2524		2679
2525	my $layout = $self->{layout};	2680	my $layout = $self->{layout};
2526		2681
		2682	$layout->set_font ($self->{font}) if $self->{font};
		2683	$layout->set_foreground (@{$para->{fg}});
2527	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2684	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2528	$layout->set_width ($self->{children}[0]{w} - $indent);	2685	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2529	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2686	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2530	$layout->set_markup ($text);	2687	$layout->set_markup ($para->{markup});
		2688
		2689	$layout->set_shapes (
		2690	map
		2691	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		2692	@{$para->{widget}}
2531		2693	);
		2694
2532	$layout->size	2695	$layout
2533	}	2696	}
2534		2697
2535	sub reflow {	2698	sub reflow {
2536	my ($self) = @_;	2699	my ($self) = @_;
2537		2700
…		…
2546	$self->{children}[1]->set_value ($offset);	2709	$self->{children}[1]->set_value ($offset);
2547	}	2710	}
2548		2711
2549	sub clear {	2712	sub clear {
2550	my ($self) = @_;	2713	my ($self) = @_;
		2714
		2715	my (undef, undef, @other) = @{ $self->{children} };
		2716	$self->remove ($_) for @other;
2551		2717
2552	$self->{par} = [];	2718	$self->{par} = [];
2553	$self->{height} = 0;	2719	$self->{height} = 0;
2554	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2720	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2555	}	2721	}
2556		2722
2557	sub add_paragraph {	2723	sub add_paragraph {
2558	my ($self, $color, $text, $indent) = @_;	2724	my ($self, $color, $para, $indent) = @_;
2559		2725
2560	for my $line (split /\n/, $text) {	2726	my ($text, @w) = ref $para ? @$para : $para;
2561	my ($w, $h) = $self->text_size ($line);	2727
2562	$self->{height} += $h;	2728	$para = {
2563	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	2729	w => 1e10,
		2730	wrapped => 1,
		2731	fg => $color,
		2732	indent => $indent,
		2733	markup => $text,
		2734	widget => \@w,
2564	}	2735	};
2565		2736
2566	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	2737	$self->add (@w) if @w;
		2738	push @{$self->{par}}, $para;
		2739
		2740	$self->{need_reflow}++;
		2741	$self->update;
		2742	}
		2743
		2744	sub scroll_to_bottom {
		2745	my ($self) = @_;
		2746
		2747	$self->{scroll_to_bottom} = 1;
		2748	$self->update;
2567	}	2749	}
2568		2750
2569	sub update {	2751	sub update {
2570	my ($self) = @_;	2752	my ($self) = @_;
2571		2753
…		…
2579	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2761	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2580		2762
2581	if (delete $self->{need_reflow}) {	2763	if (delete $self->{need_reflow}) {
2582	my $height = 0;	2764	my $height = 0;
2583		2765
2584	my $layout = $self->{layout};
2585
2586	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2587
2588	for (@{$self->{par}}) {	2766	for my $para (@{$self->{par}}) {
2589	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2767	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2590	$layout->set_width ($W - $_->[3]);	2768	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;	2769	my ($w, $h) = $layout->size;
2594	$_->[0] = $w + $_->[3];	2770
2595	$_->[1] = $h;	2771	$para->{w} = $w + $para->{indent};
		2772	$para->{h} = $h;
		2773	$para->{wrapped} = $layout->has_wrapped;
2596	}	2774	}
2597		2775
2598	$height += $_->[1];	2776	$height += $para->{h};
2599	}	2777	}
2600		2778
2601	$self->{height} = $height;	2779	$self->{height} = $height;
2602		2780
2603	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2781	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2604		2782
2605	delete $self->{texture};	2783	delete $self->{texture};
		2784	}
		2785
		2786	if (delete $self->{scroll_to_bottom}) {
		2787	$self->{children}[1]->set_value (1e10);
2606	}	2788	}
2607		2789
2608	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2790	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2609	glClearColor 0, 0, 0, 0;	2791	glClearColor 0, 0, 0, 0;
2610	glClear GL_COLOR_BUFFER_BIT;	2792	glClear GL_COLOR_BUFFER_BIT;
…		…
2614	my $y0 = $top;	2796	my $y0 = $top;
2615	my $y1 = $top + $H;	2797	my $y1 = $top + $H;
2616		2798
2617	my $y = 0;	2799	my $y = 0;
2618		2800
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}}) {	2801	for my $para (@{$self->{par}}) {
2628	my $h = $par->[1];	2802	my $h = $para->{h};
2629		2803
2630	if ($y0 < $y + $h && $y < $y1) {	2804	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		2805
2636	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2806	my $layout = $self->get_layout ($para);
2637		2807
2638	glRasterPos $par->[3], $y - $y0;	2808	$layout->render ($para->{indent}, $y - $y0);
2639	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	2809
		2810	if (my @w = @{ $para->{widget} }) {
		2811	my @s = $layout->get_shapes;
		2812
		2813	for (@w) {
		2814	my ($dx, $dy) = splice @s, 0, 2, ();
		2815
		2816	$_->{x} = $dx + $para->{indent};
		2817	$_->{y} = $dy + $y - $y0;
		2818
		2819	$_->draw;
		2820	}
		2821	}
2640	}	2822	}
2641		2823
2642	$y += $h;	2824	$y += $h;
2643	}	2825	}
2644
2645	glDisable GL_BLEND;
2646	};	2826	};
2647	});	2827	});
		2828	}
		2829
		2830	sub reconfigure {
		2831	my ($self) = @_;
		2832
		2833	$self->SUPER::reconfigure;
		2834
		2835	$_->{w} = 1e10 for @{ $self->{par} };
		2836	$self->reflow;
2648	}	2837	}
2649		2838
2650	sub _draw {	2839	sub _draw {
2651	my ($self) = @_;	2840	my ($self) = @_;
2652		2841
…		…
2655	glColor 0, 0, 0, 1;	2844	glColor 0, 0, 0, 1;
2656	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2845	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2657	glDisable GL_TEXTURE_2D;	2846	glDisable GL_TEXTURE_2D;
2658		2847
2659	$self->{children}[1]->draw;	2848	$self->{children}[1]->draw;
2660
2661	}	2849	}
2662		2850
2663	#############################################################################	2851	#############################################################################
2664		2852
2665	package CFClient::UI::Animator;	2853	package CFClient::UI::Animator;
…		…
2774	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2962	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2775		2963
2776	($w + 4, $h + 4)	2964	($w + 4, $h + 4)
2777	}	2965	}
2778		2966
2779	sub size_allocate {	2967	sub invoke_size_allocate {
2780	my ($self, $w, $h) = @_;	2968	my ($self, $w, $h) = @_;
2781		2969
2782	$self->SUPER::size_allocate ($w - 4, $h - 4);	2970	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2783	}	2971	}
2784		2972
2785	sub visibility_change {	2973	sub invoke_visibility_change {
2786	my ($self, $visible) = @_;	2974	my ($self, $visible) = @_;
2787		2975
2788	return unless $visible;	2976	return unless $visible;
2789		2977
2790	$self->{root}->on_post_alloc ("move_$self" => sub {	2978	$self->{root}->on_post_alloc ("move_$self" => sub {
…		…
2897	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3085	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2898	glDisable GL_TEXTURE_2D;	3086	glDisable GL_TEXTURE_2D;
2899	}	3087	}
2900	}	3088	}
2901		3089
2902	sub DESTROY {	3090	sub destroy {
2903	my ($self) = @_;	3091	my ($self) = @_;
2904		3092
2905	$self->{timer}->cancel	3093	$self->{timer}->cancel
2906	if $self->{timer};	3094	if $self->{timer};
2907		3095
2908	$self->SUPER::DESTROY;	3096	$self->SUPER::destroy;
2909	}	3097	}
2910		3098
2911	#############################################################################	3099	#############################################################################
2912		3100
2913	package CFClient::UI::Buttonbar;	3101	package CFClient::UI::Buttonbar;
…		…
2938	for my $item (@{ $self->{items} }) {	3126	for my $item (@{ $self->{items} }) {
2939	my ($widget, $cb, $tooltip) = @$item;	3127	my ($widget, $cb, $tooltip) = @$item;
2940		3128
2941	# handle various types of items, only text for now	3129	# handle various types of items, only text for now
2942	if (!ref $widget) {	3130	if (!ref $widget) {
		3131	if ($widget =~ /\t/) {
		3132	my ($left, $right) = split /\t/, $widget, 2;
		3133
		3134	$widget = new CFClient::UI::HBox
		3135	can_hover => 1,
		3136	can_events => 1,
		3137	tooltip => $tooltip,
		3138	children => [
		3139	(new CFClient::UI::Label markup => $left, expand => 1),
		3140	(new CFClient::UI::Label markup => $right, align => +1),
		3141	],
		3142	;
		3143
		3144	} else {
2943	$widget = new CFClient::UI::Label	3145	$widget = new CFClient::UI::Label
2944	can_hover => 1,	3146	can_hover => 1,
2945	can_events => 1,	3147	can_events => 1,
2946	markup => $widget,	3148	markup => $widget,
2947	tooltip => $tooltip	3149	tooltip => $tooltip;
		3150	}
2948	}	3151	}
2949		3152
2950	$self->{item}{$widget} = $item;	3153	$self->{item}{$widget} = $item;
2951		3154
2952	$self->{vbox}->add ($widget);	3155	$self->{vbox}->add ($widget);
…		…
2957		3160
2958	# popup given the event (must be a mouse button down event currently)	3161	# popup given the event (must be a mouse button down event currently)
2959	sub popup {	3162	sub popup {
2960	my ($self, $ev) = @_;	3163	my ($self, $ev) = @_;
2961		3164
2962	$self->_emit ("popdown");	3165	$self->emit ("popdown");
2963		3166
2964	# maybe save $GRAB? must be careful about events...	3167	# maybe save $GRAB? must be careful about events...
2965	$GRAB = $self;	3168	$GRAB = $self;
2966	$self->{button} = $ev->{button};	3169	$self->{button} = $ev->{button};
2967		3170
2968	$self->show;	3171	$self->show;
2969	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3172	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2970	}	3173	}
2971		3174
2972	sub mouse_motion {	3175	sub invoke_mouse_motion {
2973	my ($self, $ev, $x, $y) = @_;	3176	my ($self, $ev, $x, $y) = @_;
2974		3177
2975	# TODO: should use vbox->find_widget or so	3178	# TODO: should use vbox->find_widget or so
2976	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3179	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2977	$self->{hover} = $self->{item}{$HOVER};	3180	$self->{hover} = $self->{item}{$HOVER};
2978		3181
2979	0	3182	0
2980	}	3183	}
2981		3184
2982	sub button_up {	3185	sub invoke_button_up {
2983	my ($self, $ev, $x, $y) = @_;	3186	my ($self, $ev, $x, $y) = @_;
2984		3187
2985	if ($ev->{button} == $self->{button}) {	3188	if ($ev->{button} == $self->{button}) {
2986	undef $GRAB;	3189	undef $GRAB;
2987	$self->hide;	3190	$self->hide;
2988		3191
2989	$self->_emit ("popdown");	3192	$self->emit ("popdown");
2990	$self->{hover}[1]->() if $self->{hover};	3193	$self->{hover}[1]->() if $self->{hover};
2991	} else {	3194	} else {
2992	return 0	3195	return 0
2993	}	3196	}
2994		3197
…		…
3021		3224
3022	$self->{current} = $self->{children}[0]	3225	$self->{current} = $self->{children}[0]
3023	if @{ $self->{children} };	3226	if @{ $self->{children} };
3024	}	3227	}
3025		3228
		3229	sub get_current_page {
		3230	my ($self) = @_;
		3231
		3232	$self->{current}
		3233	}
		3234
3026	sub set_current_page {	3235	sub set_current_page {
3027	my ($self, $page_or_widget) = @_;	3236	my ($self, $page_or_widget) = @_;
3028		3237
3029	my $widget = ref $page_or_widget	3238	my $widget = ref $page_or_widget
3030	? $page_or_widget	3239	? $page_or_widget
3031	: $self->{children}[$page_or_widget];	3240	: $self->{children}[$page_or_widget];
3032		3241
3033	$self->{current} = $widget;	3242	$self->{current} = $widget;
3034	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3243	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3035		3244
3036	$self->_emit (page_changed => $self->{current});	3245	$self->emit (page_changed => $self->{current});
3037		3246
3038	$self->realloc;	3247	$self->realloc;
3039	}	3248	}
3040		3249
3041	sub visible_children {	3250	sub visible_children {
…		…
3046	my ($self) = @_;	3255	my ($self) = @_;
3047		3256
3048	$self->{current}->size_request	3257	$self->{current}->size_request
3049	}	3258	}
3050		3259
3051	sub size_allocate {	3260	sub invoke_size_allocate {
3052	my ($self, $w, $h) = @_;	3261	my ($self, $w, $h) = @_;
3053		3262
3054	$self->{current}->configure (0, 0, $w, $h);	3263	$self->{current}->configure (0, 0, $w, $h);
		3264
		3265	1
3055	}	3266	}
3056		3267
3057	sub _draw {	3268	sub _draw {
3058	my ($self) = @_;	3269	my ($self) = @_;
3059		3270
…		…
3094	);	3305	);
3095		3306
3096	$self->{multiplexer}->add ($widget);	3307	$self->{multiplexer}->add ($widget);
3097	}	3308	}
3098		3309
		3310	sub get_current_page {
		3311	my ($self) = @_;
		3312
		3313	$self->{multiplexer}->get_current_page
		3314	}
		3315
3099	sub set_current_page {	3316	sub set_current_page {
3100	my ($self, $page) = @_;	3317	my ($self, $page) = @_;
3101		3318
3102	$self->{multiplexer}->set_current_page ($page);	3319	$self->{multiplexer}->set_current_page ($page);
3103	$self->_emit (page_changed => $self->{multiplexer}{current});	3320	$self->emit (page_changed => $self->{multiplexer}{current});
3104	}	3321	}
3105		3322
3106	#############################################################################	3323	#############################################################################
3107		3324
3108	package CFClient::UI::Combobox;	3325	package CFClient::UI::Combobox;
…		…
3123	$self->_set_value ($self->{value});	3340	$self->_set_value ($self->{value});
3124		3341
3125	$self	3342	$self
3126	}	3343	}
3127		3344
3128	sub button_down {	3345	sub invoke_button_down {
3129	my ($self, $ev) = @_;	3346	my ($self, $ev) = @_;
3130		3347
3131	my @menu_items;	3348	my @menu_items;
3132		3349
3133	for (@{ $self->{options} }) {	3350	for (@{ $self->{options} }) {
…		…
3154	my ($self, $value) = @_;	3371	my ($self, $value) = @_;
3155		3372
3156	return unless $self->{value} ne $value;	3373	return unless $self->{value} ne $value;
3157		3374
3158	$self->_set_value ($value);	3375	$self->_set_value ($value);
3159	$self->_emit (changed => $value);	3376	$self->emit (changed => $value);
3160	}	3377	}
3161		3378
3162	#############################################################################	3379	#############################################################################
3163		3380
3164	package CFClient::UI::Statusbox;	3381	package CFClient::UI::Statusbox;
…		…
3279	count => 1,	3496	count => 1,
3280	%arg,	3497	%arg,
3281	};	3498	};
3282	}	3499	}
3283		3500
		3501	$ROOT->on_refresh (reorder => sub {
3284	$self->reorder;	3502	$self->reorder;
		3503	});
3285	}	3504	}
3286		3505
3287	sub reconfigure {	3506	sub reconfigure {
3288	my ($self) = @_;	3507	my ($self) = @_;
3289		3508
…		…
3292		3511
3293	$self->reorder;	3512	$self->reorder;
3294	$self->SUPER::reconfigure;	3513	$self->SUPER::reconfigure;
3295	}	3514	}
3296		3515
3297	sub DESTROY {	3516	sub destroy {
3298	my ($self) = @_;	3517	my ($self) = @_;
3299		3518
3300	$self->{timer}->cancel;	3519	$self->{timer}->cancel;
3301		3520
3302	$self->SUPER::DESTROY;	3521	$self->SUPER::destroy;
3303	}	3522	}
3304		3523
3305	#############################################################################	3524	#############################################################################
3306		3525
3307	package CFClient::UI::Inventory;	3526	package CFClient::UI::Inventory;
3308		3527
3309	our @ISA = CFClient::UI::ScrolledWindow::;	3528	our @ISA = CFClient::UI::Table::;
3310		3529
3311	sub new {	3530	sub new {
3312	my $class = shift;	3531	my $class = shift;
3313		3532
3314	my $self = $class->SUPER::new (	3533	my $self = $class->SUPER::new (
3315	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),	3534	col_expand => [0, 1, 0],
3316	@_,	3535	@_,
3317	);	3536	);
3318		3537
3319	$self	3538	$self
3320	}	3539	}
3321		3540
3322	sub set_items {	3541	sub set_items {
3323	my ($self, $items) = @_;	3542	my ($self, $items) = @_;
3324		3543
3325	$self->{child}->clear;	3544	$self->clear;
3326	return unless $items;	3545	return unless $items;
3327		3546
3328	my @items = sort {	3547	my @items = sort {
3329	($a->{type} <=> $b->{type})	3548	($a->{type} <=> $b->{type})
3330	or ($a->{name} cmp $b->{name})	3549	or ($a->{name} cmp $b->{name})
3331	} @$items;	3550	} values %$items;
3332		3551
3333	$self->{real_items} = \@items;	3552	$self->{real_items} = \@items;
3334		3553
3335	my $row = 0;	3554	my $row = 0;
3336	for my $item (@items) {	3555	for my $item (@items) {
3337	CFClient::Item::update_widgets $item;	3556	CFClient::Item::update_widgets $item;
3338		3557
3339	$self->{child}->add (0, $row, $item->{face_widget});	3558	$self->add (0, $row, $item->{face_widget});
3340	$self->{child}->add (1, $row, $item->{desc_widget});	3559	$self->add (1, $row, $item->{desc_widget});
3341	$self->{child}->add (2, $row, $item->{weight_widget});	3560	$self->add (2, $row, $item->{weight_widget});
3342		3561
3343	$row++;	3562	$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;
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	}	3563	}
3542	}	3564	}
3543		3565
3544	#############################################################################	3566	#############################################################################
3545		3567
…		…
3574	my ($self) = @_;	3596	my ($self) = @_;
3575		3597
3576	$CFClient::UI::ROOT->on_refresh ($self => sub {	3598	$CFClient::UI::ROOT->on_refresh ($self => sub {
3577	$self->clear;	3599	$self->clear;
3578		3600
		3601	return unless $::CONN;
		3602
3579	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);	3603	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3580	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);	3604	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3581	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);	3605	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3582	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);	3606	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3583	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);	3607	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
…		…
3597	} elsif ($ev->{button} == 2) {	3621	} elsif ($ev->{button} == 2) {
3598	$::CONN->user_send ("invoke $spell->{name}");	3622	$::CONN->user_send ("invoke $spell->{name}");
3599	} elsif ($ev->{button} == 3) {	3623	} elsif ($ev->{button} == 3) {
3600	(new CFClient::UI::Menu	3624	(new CFClient::UI::Menu
3601	items => [	3625	items => [
3602	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],	3626	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3603	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],	3627	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3604	],	3628	],
3605	)->popup ($ev);	3629	)->popup ($ev);
3606	} else {	3630	} else {
3607	return 0;	3631	return 0;
…		…
3702	$coord = $max - $size if $coord > $max - $size;	3726	$coord = $max - $size if $coord > $max - $size;
3703		3727
3704	int $coord + 0.5	3728	int $coord + 0.5
3705	}	3729	}
3706		3730
3707	sub size_allocate {	3731	sub invoke_size_allocate {
3708	my ($self, $w, $h) = @_;	3732	my ($self, $w, $h) = @_;
3709		3733
3710	for my $child ($self->children) {	3734	for my $child ($self->children) {
3711	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3735	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3712		3736
…		…
3716	$X = _to_pixel $X, $W, $self->{w};	3740	$X = _to_pixel $X, $W, $self->{w};
3717	$Y = _to_pixel $Y, $H, $self->{h};	3741	$Y = _to_pixel $Y, $H, $self->{h};
3718		3742
3719	$child->configure ($X, $Y, $W, $H);	3743	$child->configure ($X, $Y, $W, $H);
3720	}	3744	}
		3745
		3746	1
3721	}	3747	}
3722		3748
3723	sub coord2local {	3749	sub coord2local {
3724	my ($self, $x, $y) = @_;	3750	my ($self, $x, $y) = @_;
3725		3751
…		…
3851	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3877	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3852		3878
3853	$w = 0 if $w < 0;	3879	$w = 0 if $w < 0;
3854	$h = 0 if $h < 0;	3880	$h = 0 if $h < 0;
3855		3881
		3882	$w = max $widget->{min_w}, $w;
		3883	$h = max $widget->{min_h}, $h;
		3884
		3885	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3886	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3887
3856	$w = int $w + 0.5;	3888	$w = int $w + 0.5;
3857	$h = int $h + 0.5;	3889	$h = int $h + 0.5;
3858		3890
3859	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	3891	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3860	$widget->{old_w} = $widget->{w};	3892	$widget->{old_w} = $widget->{w};

Diff Legend

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