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.288 by root, Mon Jun 5 21:14:40 2006 UTC vs.
Revision 1.314 by root, Mon Jun 26 21:59:04 2006 UTC

…		…
272		272
273	return unless $self->{visible};	273	return unless $self->{visible};
274		274
275	$_->set_invisible for $self->children;	275	$_->set_invisible for $self->children;
276		276
		277	delete $self->{visible};
277	delete $self->{root};	278	delete $self->{root};
278	delete $self->{visible};
279		279
280	undef $GRAB if $GRAB == $self;	280	undef $GRAB if $GRAB == $self;
281	undef $HOVER if $HOVER == $self;	281	undef $HOVER if $HOVER == $self;
282		282
283	$CFClient::UI::TOOLTIP_WATCHER->cb->()	283	$CFClient::UI::TOOLTIP_WATCHER->cb->()
284	if $TOOLTIP->{owner} == $self;	284	if $TOOLTIP->{owner} == $self;
285		285
286	$self->focus_out;	286	$self->emit ("focus_out");
287
288	$self->emit (visibility_change => 0);	287	$self->emit (visibility_change => 0);
289	}	288	}
290		289
291	sub set_visibility {	290	sub set_visibility {
292	my ($self, $visible) = @_;	291	my ($self, $visible) = @_;
…		…
315	}	314	}
316		315
317	sub move_abs {	316	sub move_abs {
318	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
319		318
320	$self->{x} = List::Util::max 0, int $x;	319	$self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
321	$self->{y} = List::Util::max 0, int $y;	320	$self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
322	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
323		322
324	$self->update;	323	$self->update;
325	}	324	}
326		325
…		…
334	}	333	}
335		334
336	sub size_request {	335	sub size_request {
337	require Carp;	336	require Carp;
338	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
		338	}
		339
		340	sub baseline_shift {
		341	0
339	}	342	}
340		343
341	sub configure {	344	sub configure {
342	my ($self, $x, $y, $w, $h) = @_;	345	my ($self, $x, $y, $w, $h) = @_;
343		346
…		…
367		370
368	$self->{root}{size_alloc}{$self+0} = $self;	371	$self->{root}{size_alloc}{$self+0} = $self;
369	}	372	}
370	}	373	}
371		374
372	sub size_allocate {
373	# nothing to be done
374	}
375
376	sub children {	375	sub children {
377	# nop	376	# nop
378	}	377	}
379		378
380	sub visible_children {	379	sub visible_children {
…		…
418	my ($self, $x, $y) = @_;	417	my ($self, $x, $y) = @_;
419		418
420	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	419	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421	}	420	}
422		421
423	sub focus_in {	422	sub invoke_focus_in {
424	my ($self) = @_;	423	my ($self) = @_;
425		424
426	return if $FOCUS == $self;	425	return if $FOCUS == $self;
427	return unless $self->{can_focus};	426	return unless $self->{can_focus};
428		427
429	my $focus = $FOCUS; $FOCUS = $self;	428	my $focus = $FOCUS; $FOCUS = $self;
430		429
431	$self->_emit (focus_in => $focus);
432
433	$focus->update if $focus;	430	$focus->update if $focus;
434	$FOCUS->update;	431	$FOCUS->update;
435	}
436		432
		433	0
		434	}
		435
437	sub focus_out {	436	sub invoke_focus_out {
438	my ($self) = @_;	437	my ($self) = @_;
439		438
440	return unless $FOCUS == $self;	439	return unless $FOCUS == $self;
441		440
442	my $focus = $FOCUS; undef $FOCUS;	441	my $focus = $FOCUS; undef $FOCUS;
443		442
444	$self->_emit (focus_out => $focus);
445
446	$focus->update if $focus; #?	443	$focus->update if $focus; #?
447		444
448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	445	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449	unless $FOCUS;	446	unless $FOCUS;
450	}
451		447
		448	0
		449	}
		450
		451	sub grab_focus {
		452	my ($self) = @_;
		453
		454	$self->emit ("focus_in");
		455	}
		456
452	sub mouse_motion { 0 }	457	sub invoke_mouse_motion { 1 }
453	sub button_up { 0 }	458	sub invoke_button_up { 1 }
454	sub key_down { 0 }	459	sub invoke_key_down { 1 }
455	sub key_up { 0 }	460	sub invoke_key_up { 1 }
456		461
457	sub button_down {	462	sub invoke_button_down {
458	my ($self, $ev, $x, $y) = @_;	463	my ($self, $ev, $x, $y) = @_;
459		464
460	$self->focus_in;	465	$self->grab_focus;
461		466
462	0	467	1
		468	}
		469
		470	sub connect {
		471	my ($self, $signal, $cb) = @_;
		472
		473	push @{ $self->{signal_cb}{$signal} }, $cb;
		474	}
		475
		476	sub emit {
		477	my ($self, $signal, @args) = @_;
		478
		479	#d##TODO# stop propagating at first true, do not use sum
		480	(List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before
		481	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args) # closure
		482	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
463	}	483	}
464		484
465	sub find_widget {	485	sub find_widget {
466	my ($self, $x, $y) = @_;	486	my ($self, $x, $y) = @_;
467		487
…		…
477	sub set_parent {	497	sub set_parent {
478	my ($self, $parent) = @_;	498	my ($self, $parent) = @_;
479		499
480	Scalar::Util::weaken ($self->{parent} = $parent);	500	Scalar::Util::weaken ($self->{parent} = $parent);
481	$self->set_visible if $parent->{visible};	501	$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	}	502	}
506		503
507	sub realloc {	504	sub realloc {
508	my ($self) = @_;	505	my ($self) = @_;
509		506
…		…
526	}	523	}
527		524
528	sub reconfigure {	525	sub reconfigure {
529	my ($self) = @_;	526	my ($self) = @_;
530		527
531	# some widgets cache req_w and req_h
532	delete $self->{req_w};
533	delete $self->{req_h};
534
535	$self->realloc;	528	$self->realloc;
536	$self->update;	529	$self->update;
537	}	530	}
538		531
539	# using global variables seems a bit hacky, but passing through all drawing	532	# using global variables seems a bit hacky, but passing through all drawing
…		…
546	return unless $self->{h} && $self->{w};	539	return unless $self->{h} && $self->{w};
547		540
548	# update screen rectangle	541	# update screen rectangle
549	local $draw_x = $draw_x + $self->{x};	542	local $draw_x = $draw_x + $self->{x};
550	local $draw_y = $draw_y + $self->{y};	543	local $draw_y = $draw_y + $self->{y};
551	local $draw_w = $draw_x + $self->{w};
552	local $draw_h = $draw_y + $self->{h};
553		544
554	# skip widgets that are entirely outside the drawing area	545	# skip widgets that are entirely outside the drawing area
555	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)	546	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
556	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);	547	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
557		548
…		…
597		588
598	sub DESTROY {	589	sub DESTROY {
599	my ($self) = @_;	590	my ($self) = @_;
600		591
601	delete $WIDGET{$self+0};	592	delete $WIDGET{$self+0};
602	#$self->deactivate;	593
		594	eval { $self->destroy };
		595	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
603	}	596	}
604		597
605	#############################################################################	598	#############################################################################
606		599
607	package CFClient::UI::DrawBG;	600	package CFClient::UI::DrawBG;
…		…
772	}	765	}
773		766
774	sub add {	767	sub add {
775	my ($self, $child) = @_;	768	my ($self, $child) = @_;
776		769
777	$self->{children} = [];	770	$self->SUPER::remove ($_) for @{ $self->{children} };
778
779	$self->SUPER::add ($child);	771	$self->SUPER::add ($child);
780	}	772	}
781		773
782	sub remove {	774	sub remove {
783	my ($self, $widget) = @_;	775	my ($self, $widget) = @_;
…		…
792		784
793	sub size_request {	785	sub size_request {
794	$_[0]{children}[0]->size_request	786	$_[0]{children}[0]->size_request
795	}	787	}
796		788
797	sub size_allocate {	789	sub invoke_size_allocate {
798	my ($self, $w, $h) = @_;	790	my ($self, $w, $h) = @_;
799		791
800	$self->{children}[0]->configure (0, 0, $w, $h);	792	$self->{children}[0]->configure (0, 0, $w, $h);
		793
		794	1
801	}	795	}
802		796
803	#############################################################################	797	#############################################################################
804		798
805	# back-buffered drawing area	799	# back-buffered drawing area
…		…
821		815
822	$ROOT->on_post_alloc ($self => sub { $self->render_child });	816	$ROOT->on_post_alloc ($self => sub { $self->render_child });
823	$self->SUPER::update;	817	$self->SUPER::update;
824	}	818	}
825		819
826	sub size_allocate {	820	sub invoke_size_allocate {
827	my ($self, $w, $h) = @_;	821	my ($self, $w, $h) = @_;
828		822
829	$self->SUPER::size_allocate ($w, $h);
830	$self->update;	823	$self->update;
		824
		825	$self->SUPER::invoke_size_allocate ($w, $h)
831	}	826	}
832		827
833	sub _render {	828	sub _render {
834	my ($self) = @_;	829	my ($self) = @_;
835		830
…		…
896	$h = 10 if $self->{scroll_y};	891	$h = 10 if $self->{scroll_y};
897		892
898	($w, $h)	893	($w, $h)
899	}	894	}
900		895
901	sub size_allocate {	896	sub invoke_size_allocate {
902	my ($self, $w, $h) = @_;	897	my ($self, $w, $h) = @_;
903		898
904	my $child = $self->child;	899	my $child = $self->child;
905		900
906	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};	901	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
907	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};	902	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
908		903
909	$self->child->configure (0, 0, $w, $h);	904	$self->child->configure (0, 0, $w, $h);
910	$self->update;	905	$self->update;
		906
		907	1
911	}	908	}
912		909
913	sub set_offset {	910	sub set_offset {
914	my ($self, $x, $y) = @_;	911	my ($self, $x, $y) = @_;
915		912
…		…
989	$self->add ($child) if $child;	986	$self->add ($child) if $child;
990		987
991	$self	988	$self
992	}	989	}
993		990
		991	#TODO# update range on size_allocate depending on child
		992
994	sub add {	993	sub add {
995	my ($self, $widget) = @_;	994	my ($self, $widget) = @_;
996		995
997	$self->{vp}->add ($self->{child} = $widget);	996	$self->{vp}->add ($self->{child} = $widget);
998	}	997	}
999		998
		999	sub update_slider {
		1000	my ($self) = @_;
		1001
		1002	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
		1003	}
		1004
1000	sub update {	1005	sub update {
1001	my ($self) = @_;	1006	my ($self) = @_;
1002		1007
1003	$self->SUPER::update;	1008	$self->SUPER::update;
1004		1009
1005	# todo: overwrite size_allocate of child	1010	$self->update_slider;
1006	my $child = $self->{vp}->child;
1007	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1008	}	1011	}
1009		1012
1010	sub size_allocate {	1013	sub invoke_size_allocate {
1011	my ($self, $w, $h) = @_;	1014	my ($self, $w, $h) = @_;
1012		1015
		1016	$self->update_slider;
		1017
1013	$self->SUPER::size_allocate ($w, $h);	1018	$self->SUPER::invoke_size_allocate ($w, $h)
1014
1015	my $child = $self->{vp}->child;
1016	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1017	}	1019	}
1018
1019	#TODO# update range on size_allocate depending on child
1020	# update viewport offset on scroll
1021		1020
1022	#############################################################################	1021	#############################################################################
1023		1022
1024	package CFClient::UI::Frame;	1023	package CFClient::UI::Frame;
1025		1024
…		…
1075	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1074	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1076	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1075	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1077		1076
1078	sub new {	1077	sub new {
1079	my ($class, %arg) = @_;	1078	my ($class, %arg) = @_;
1080
1081	my $title = delete $arg{title};
1082		1079
1083	my $self = $class->SUPER::new (	1080	my $self = $class->SUPER::new (
1084	bg => [1, 1, 1, 1],	1081	bg => [1, 1, 1, 1],
1085	border_bg => [1, 1, 1, 1],	1082	border_bg => [1, 1, 1, 1],
1086	border => 0.6,	1083	border => 0.6,
…		…
1088	min_w => 16,	1085	min_w => 16,
1089	min_h => 16,	1086	min_h => 16,
1090	%arg,	1087	%arg,
1091	);	1088	);
1092		1089
1093	$self->{title} = new CFClient::UI::Label	1090	$self->{title_widget} = new CFClient::UI::Label
1094	align => 0,	1091	align => 0,
1095	valign => 1,	1092	valign => 1,
1096	text => $title,	1093	text => $self->{title},
1097	fontsize => $self->{border}	1094	fontsize => $self->{border},
1098	if defined $title;	1095	if exists $self->{title};
		1096
		1097	if ($self->{has_close_button}) {
		1098	$self->{close_button} =
		1099	new CFClient::UI::ImageButton
		1100	path => 'x1_close.png',
		1101	on_activate => sub { $self->hide };
		1102
		1103	$self->CFClient::UI::Container::add ($self->{close_button});
		1104	}
1099		1105
1100	$self	1106	$self
1101	}	1107	}
1102		1108
1103	sub add {	1109	sub add {
1104	my ($self, @widgets) = @_;	1110	my ($self, @widgets) = @_;
1105		1111
1106	$self->SUPER::add (@widgets);	1112	$self->SUPER::add (@widgets);
		1113	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1107	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};	1114	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1108	}	1115	}
1109		1116
1110	sub border {	1117	sub border {
1111	int $_[0]{border} * $::FONTSIZE	1118	int $_[0]{border} * $::FONTSIZE
1112	}	1119	}
1113		1120
1114	sub size_request {	1121	sub size_request {
1115	my ($self) = @_;	1122	my ($self) = @_;
1116		1123
1117	$self->{title}->size_request	1124	$self->{title_widget}->size_request
1118	if $self->{title};	1125	if $self->{title_widget};
		1126
		1127	$self->{close_button}->size_request
		1128	if $self->{close_button};
1119		1129
1120	my ($w, $h) = $self->SUPER::size_request;	1130	my ($w, $h) = $self->SUPER::size_request;
1121		1131
1122	(	1132	(
1123	$w + $self->border * 2,	1133	$w + $self->border * 2,
1124	$h + $self->border * 2,	1134	$h + $self->border * 2,
1125	)	1135	)
1126	}	1136	}
1127		1137
1128	sub size_allocate {	1138	sub invoke_size_allocate {
1129	my ($self, $w, $h) = @_;	1139	my ($self, $w, $h) = @_;
1130		1140
1131	if ($self->{title}) {	1141	if ($self->{title_widget}) {
1132	$self->{title}{w} = $w;	1142	$self->{title_widget}{w} = $w;
1133	$self->{title}{h} = $h;	1143	$self->{title_widget}{h} = $h;
1134	$self->{title}->size_allocate ($w, $h);	1144	$self->{title_widget}->invoke_size_allocate ($w, $h);
1135	}	1145	}
1136		1146
1137	my $border = $self->border;	1147	my $border = $self->border;
1138		1148
1139	$h -= List::Util::max 0, $border * 2;	1149	$h -= List::Util::max 0, $border * 2;
1140	$w -= List::Util::max 0, $border * 2;	1150	$w -= List::Util::max 0, $border * 2;
1141		1151
1142	$self->child->configure ($border, $border, $w, $h);	1152	$self->child->configure ($border, $border, $w, $h);
1143	}
1144		1153
		1154	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1155	if $self->{close_button};
		1156
		1157	1
		1158	}
		1159
1145	sub button_down {	1160	sub invoke_button_down {
1146	my ($self, $ev, $x, $y) = @_;	1161	my ($self, $ev, $x, $y) = @_;
1147		1162
1148	my ($w, $h) = @$self{qw(w h)};	1163	my ($w, $h) = @$self{qw(w h)};
1149	my $border = $self->border;	1164	my $border = $self->border;
1150		1165
…		…
1181		1196
1182	($x, $y) = ($ev->{x}, $ev->{y});	1197	($x, $y) = ($ev->{x}, $ev->{y});
1183		1198
1184	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1199	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1185	# HACK: the next line is required to enforce placement	1200	# HACK: the next line is required to enforce placement
1186	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1201	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1187	};	1202	};
1188	} else {	1203	} else {
1189	return 0;	1204	return 0;
1190	}	1205	}
1191		1206
1192	1	1207	1
1193	}	1208	}
1194		1209
1195	sub button_up {	1210	sub invoke_button_up {
1196	my ($self, $ev, $x, $y) = @_;	1211	my ($self, $ev, $x, $y) = @_;
1197		1212
1198	!!delete $self->{motion}	1213	! ! delete $self->{motion}
1199	}	1214	}
1200		1215
1201	sub mouse_motion {	1216	sub invoke_mouse_motion {
1202	my ($self, $ev, $x, $y) = @_;	1217	my ($self, $ev, $x, $y) = @_;
1203		1218
1204	$self->{motion}->($ev, $x, $y) if $self->{motion};	1219	$self->{motion}->($ev, $x, $y) if $self->{motion};
1205		1220
1206	!!$self->{motion}	1221	! ! $self->{motion}
1207	}	1222	}
1208		1223
1209	sub _draw {	1224	sub _draw {
1210	my ($self) = @_;	1225	my ($self) = @_;
1211		1226
…		…
1237		1252
1238	glDisable GL_TEXTURE_2D;	1253	glDisable GL_TEXTURE_2D;
1239		1254
1240	$child->draw;	1255	$child->draw;
1241		1256
1242	if ($self->{title}) {	1257	if ($self->{title_widget}) {
1243	glTranslate 0, $border - $self->{h};	1258	glTranslate 0, $border - $self->{h};
1244	$self->{title}->_draw;	1259	$self->{title_widget}->_draw;
		1260
		1261	glTranslate 0, - ($border - $self->{h});
1245	}	1262	}
		1263
		1264	$self->{close_button}->draw
		1265	if $self->{close_button};
1246	}	1266	}
1247		1267
1248	#############################################################################	1268	#############################################################################
1249		1269
1250	package CFClient::UI::Table;	1270	package CFClient::UI::Table;
…		…
1273		1293
1274	$child->set_parent ($self);	1294	$child->set_parent ($self);
1275	$self->{children}[$y][$x] = $child;	1295	$self->{children}[$y][$x] = $child;
1276		1296
1277	$self->realloc;	1297	$self->realloc;
		1298	}
		1299
		1300	sub remove {
		1301	my ($self, $child) = @_;
		1302
		1303	# TODO: not yet implemented
1278	}	1304	}
1279		1305
1280	# TODO: move to container class maybe? send children a signal on removal?	1306	# TODO: move to container class maybe? send children a signal on removal?
1281	sub clear {	1307	sub clear {
1282	my ($self) = @_;	1308	my ($self) = @_;
…		…
1323	(sum @$ws),	1349	(sum @$ws),
1324	(sum @$hs),	1350	(sum @$hs),
1325	)	1351	)
1326	}	1352	}
1327		1353
1328	sub size_allocate {	1354	sub invoke_size_allocate {
1329	my ($self, $w, $h) = @_;	1355	my ($self, $w, $h) = @_;
1330		1356
1331	my ($ws, $hs) = $self->get_wh;	1357	my ($ws, $hs) = $self->get_wh;
1332		1358
1333	my $req_w = (sum @$ws) || 1;	1359	my $req_w = (sum @$ws) || 1;
…		…
1365	}	1391	}
1366		1392
1367	$y += $row_h;	1393	$y += $row_h;
1368	}	1394	}
1369		1395
		1396	1
1370	}	1397	}
1371		1398
1372	sub find_widget {	1399	sub find_widget {
1373	my ($self, $x, $y) = @_;	1400	my ($self, $x, $y) = @_;
1374		1401
…		…
1411	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1438	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1412	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1439	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1413	)	1440	)
1414	}	1441	}
1415		1442
1416	sub size_allocate {	1443	sub invoke_size_allocate {
1417	my ($self, $w, $h) = @_;	1444	my ($self, $w, $h) = @_;
1418		1445
1419	my $space = $self->{vertical} ? $h : $w;	1446	my $space = $self->{vertical} ? $h : $w;
1420	my $children = $self->{children};	1447	my @children = $self->visible_children;
1421		1448
1422	my @req;	1449	my @req;
1423		1450
1424	if ($self->{homogeneous}) {	1451	if ($self->{homogeneous}) {
1425	@req = ($space / (@$children || 1)) x @$children;	1452	@req = ($space / (@children || 1)) x @children;
1426	} else {	1453	} else {
1427	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1454	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1428	my $req = List::Util::sum @req;	1455	my $req = List::Util::sum @req;
1429		1456
1430	if ($req > $space) {	1457	if ($req > $space) {
1431	# ah well, not enough space	1458	# ah well, not enough space
1432	$_ *= $space / $req for @req;	1459	$_ *= $space / $req for @req;
1433	} else {	1460	} else {
1434	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1461	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1435		1462
1436	$space = ($space - $req) / $expand; # remaining space to give away	1463	$space = ($space - $req) / $expand; # remaining space to give away
1437		1464
1438	$req[$_] += $space * $children->[$_]{expand}	1465	$req[$_] += $space * $children[$_]{expand}
1439	for 0 .. $#$children;	1466	for 0 .. $#children;
1440	}	1467	}
1441	}	1468	}
1442		1469
1443	CFClient::UI::harmonize \@req;	1470	CFClient::UI::harmonize \@req;
1444		1471
1445	my $pos = 0;	1472	my $pos = 0;
1446	for (0 .. $#$children) {	1473	for (0 .. $#children) {
1447	my $alloc = $req[$_];	1474	my $alloc = $req[$_];
1448	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1475	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1449		1476
1450	$pos += $alloc;	1477	$pos += $alloc;
1451	}	1478	}
1452		1479
1453	1	1480	1
…		…
1559	$self->{text} = "T$text";	1586	$self->{text} = "T$text";
1560		1587
1561	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1588	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1562	$self->{layout}->set_text ($text);	1589	$self->{layout}->set_text ($text);
1563		1590
1564	delete $self->{req_h};	1591	delete $self->{size_req};
1565	$self->realloc;	1592	$self->realloc;
1566	$self->update;	1593	$self->update;
1567	}	1594	}
1568		1595
1569	sub set_markup {	1596	sub set_markup {
…		…
1575	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1602	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1576		1603
1577	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1604	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1578	$self->{layout}->set_markup ($markup);	1605	$self->{layout}->set_markup ($markup);
1579		1606
1580	delete $self->{req_h};	1607	delete $self->{size_req};
1581	$self->realloc;	1608	$self->realloc;
1582	$self->update;	1609	$self->update;
1583	}	1610	}
1584		1611
1585	sub size_request {	1612	sub size_request {
1586	my ($self) = @_;	1613	my ($self) = @_;
1587		1614
1588	if (exists $self->{req_h}) {	1615	$self->{size_req} ||= do {
1589	@$self{qw(req_w req_h)}
1590	} else {
1591	$self->{layout}->set_font ($self->{font}) if $self->{font};	1616	$self->{layout}->set_font ($self->{font}) if $self->{font};
1592	$self->{layout}->set_width ($self->{max_w} || -1);	1617	$self->{layout}->set_width ($self->{max_w} || -1);
1593	$self->{layout}->set_ellipsise ($self->{ellipsise});	1618	$self->{layout}->set_ellipsise ($self->{ellipsise});
1594	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1619	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1595	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1620	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
…		…
1604		1629
1605	$w = List::Util::max $w, $w2;	1630	$w = List::Util::max $w, $w2;
1606	$h = List::Util::max $h, $h2;	1631	$h = List::Util::max $h, $h2;
1607	}	1632	}
1608		1633
1609	($w, $h)	1634	[$w, $h]
1610	}	1635	};
1611	}
1612		1636
		1637	@{ $self->{size_req} }
		1638	}
		1639
		1640	sub baseline_shift {
		1641	$_[0]{layout}->descent
		1642	}
		1643
1613	sub size_allocate {	1644	sub invoke_size_allocate {
1614	my ($self, $w, $h) = @_;	1645	my ($self, $w, $h) = @_;
1615		1646
1616	delete $self->{ox};	1647	delete $self->{ox};
1617		1648
1618	delete $self->{texture}	1649	delete $self->{texture}
1619	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};	1650	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1651
		1652	1
1620	}	1653	}
1621		1654
1622	sub set_fontsize {	1655	sub set_fontsize {
1623	my ($self, $fontsize) = @_;	1656	my ($self, $fontsize) = @_;
1624		1657
1625	$self->{fontsize} = $fontsize;	1658	$self->{fontsize} = $fontsize;
1626	delete $self->{texture};	1659	delete $self->{texture};
1627		1660
1628	$self->realloc;	1661	$self->realloc;
		1662	}
		1663
		1664	sub reconfigure {
		1665	my ($self) = @_;
		1666
		1667	delete $self->{size_req};
		1668
		1669	$self->SUPER::reconfigure;
1629	}	1670	}
1630		1671
1631	sub _draw {	1672	sub _draw {
1632	my ($self) = @_;	1673	my ($self) = @_;
1633		1674
…		…
1654	: ($self->{h} - $tex->{h}) * 0.5);	1695	: ($self->{h} - $tex->{h}) * 0.5);
1655	};	1696	};
1656		1697
1657	glEnable GL_TEXTURE_2D;	1698	glEnable GL_TEXTURE_2D;
1658		1699
		1700	my $w = List::Util::min $self->{w} + 4, $tex->{w};
		1701	my $h = List::Util::min $self->{h} + 2, $tex->{h};
		1702
1659	if ($tex->{format} == GL_ALPHA) {	1703	if ($tex->{format} == GL_ALPHA) {
1660	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1704	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1661	glColor @{$self->{fg}};	1705	glColor @{$self->{fg}};
1662	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1706	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1663	} else {	1707	} else {
1664	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1708	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1665	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1709	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1666	}	1710	}
1667		1711
1668	glDisable GL_TEXTURE_2D;	1712	glDisable GL_TEXTURE_2D;
1669	}	1713	}
1670		1714
…		…
1687	can_hover => 1,	1731	can_hover => 1,
1688	can_focus => 1,	1732	can_focus => 1,
1689	valign => 0,	1733	valign => 0,
1690	can_events => 1,	1734	can_events => 1,
1691	#text => ...	1735	#text => ...
		1736	#hidden => "*",
1692	@_	1737	@_
1693	)	1738	)
1694	}	1739	}
1695		1740
1696	sub _set_text {	1741	sub _set_text {
…		…
1703	$self->{last_activity} = $::NOW;	1748	$self->{last_activity} = $::NOW;
1704	$self->{text} = $text;	1749	$self->{text} = $text;
1705		1750
1706	$text =~ s/./*/g if $self->{hidden};	1751	$text =~ s/./*/g if $self->{hidden};
1707	$self->{layout}->set_text ("$text ");	1752	$self->{layout}->set_text ("$text ");
1708	delete $self->{req_h};	1753	delete $self->{size_req};
1709		1754
1710	$self->_emit (changed => $self->{text});	1755	$self->emit (changed => $self->{text});
1711		1756
1712	$self->realloc;	1757	$self->realloc;
1713	$self->update;	1758	$self->update;
1714	}	1759	}
1715		1760
…		…
1730	my ($w, $h) = $self->SUPER::size_request;	1775	my ($w, $h) = $self->SUPER::size_request;
1731		1776
1732	($w + 1, $h) # add 1 for cursor	1777	($w + 1, $h) # add 1 for cursor
1733	}	1778	}
1734		1779
1735	sub key_down {	1780	sub invoke_key_down {
1736	my ($self, $ev) = @_;	1781	my ($self, $ev) = @_;
1737		1782
1738	my $mod = $ev->{mod};	1783	my $mod = $ev->{mod};
1739	my $sym = $ev->{sym};	1784	my $sym = $ev->{sym};
1740	my $uni = $ev->{unicode};	1785	my $uni = $ev->{unicode};
…		…
1752	} elsif ($sym == CFClient::SDLK_HOME) {	1797	} elsif ($sym == CFClient::SDLK_HOME) {
1753	$self->{cursor} = 0;	1798	$self->{cursor} = 0;
1754	} elsif ($sym == CFClient::SDLK_END) {	1799	} elsif ($sym == CFClient::SDLK_END) {
1755	$self->{cursor} = length $text;	1800	$self->{cursor} = length $text;
1756	} elsif ($uni == 27) {	1801	} elsif ($uni == 27) {
1757	$self->_emit ('escape');	1802	$self->emit ('escape');
1758	} elsif ($uni) {	1803	} elsif ($uni) {
1759	substr $text, $self->{cursor}++, 0, chr $uni;	1804	substr $text, $self->{cursor}++, 0, chr $uni;
1760	} else {	1805	} else {
1761	return 0;	1806	return 0;
1762	}	1807	}
…		…
1766	$self->realloc;	1811	$self->realloc;
1767		1812
1768	1	1813	1
1769	}	1814	}
1770		1815
1771	sub focus_in {	1816	sub invoke_focus_in {
1772	my ($self) = @_;	1817	my ($self) = @_;
1773		1818
1774	$self->{last_activity} = $::NOW;	1819	$self->{last_activity} = $::NOW;
1775		1820
1776	$self->SUPER::focus_in;	1821	$self->SUPER::invoke_focus_in
1777	}	1822	}
1778		1823
1779	sub button_down {	1824	sub invoke_button_down {
1780	my ($self, $ev, $x, $y) = @_;	1825	my ($self, $ev, $x, $y) = @_;
1781		1826
1782	$self->SUPER::button_down ($ev, $x, $y);	1827	$self->SUPER::invoke_button_down ($ev, $x, $y);
1783		1828
1784	my $idx = $self->{layout}->xy_to_index ($x, $y);	1829	my $idx = $self->{layout}->xy_to_index ($x, $y);
1785		1830
1786	# byte-index to char-index	1831	# byte-index to char-index
1787	my $text = $self->{text};	1832	my $text = $self->{text};
…		…
1792	$self->update;	1837	$self->update;
1793		1838
1794	1	1839	1
1795	}	1840	}
1796		1841
1797	sub mouse_motion {	1842	sub invoke_mouse_motion {
1798	my ($self, $ev, $x, $y) = @_;	1843	my ($self, $ev, $x, $y) = @_;
1799	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1844	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1800		1845
1801	0	1846	1
1802	}	1847	}
1803		1848
1804	sub _draw {	1849	sub _draw {
1805	my ($self) = @_;	1850	my ($self) = @_;
1806		1851
…		…
1847		1892
1848	our @ISA = CFClient::UI::EntryBase::;	1893	our @ISA = CFClient::UI::EntryBase::;
1849		1894
1850	use CFClient::OpenGL;	1895	use CFClient::OpenGL;
1851		1896
1852	sub key_down {	1897	sub invoke_key_down {
1853	my ($self, $ev) = @_;	1898	my ($self, $ev) = @_;
1854		1899
1855	my $sym = $ev->{sym};	1900	my $sym = $ev->{sym};
1856		1901
1857	if ($sym == 13) {	1902	if ($sym == 13) {
1858	unshift @{$self->{history}},	1903	unshift @{$self->{history}},
1859	my $txt = $self->get_text;	1904	my $txt = $self->get_text;
		1905
1860	$self->{history_pointer} = -1;	1906	$self->{history_pointer} = -1;
1861	$self->{history_saveback} = '';	1907	$self->{history_saveback} = '';
1862	$self->_emit (activate => $txt);	1908	$self->emit (activate => $txt);
1863	$self->update;	1909	$self->update;
1864		1910
1865	} elsif ($sym == CFClient::SDLK_UP) {	1911	} elsif ($sym == CFClient::SDLK_UP) {
1866	if ($self->{history_pointer} < 0) {	1912	if ($self->{history_pointer} < 0) {
1867	$self->{history_saveback} = $self->get_text;	1913	$self->{history_saveback} = $self->get_text;
…		…
1883	} else {	1929	} else {
1884	$self->set_text ($self->{history_saveback});	1930	$self->set_text ($self->{history_saveback});
1885	}	1931	}
1886		1932
1887	} else {	1933	} else {
1888	return $self->SUPER::key_down ($ev)	1934	return $self->SUPER::invoke_key_down ($ev)
1889	}	1935	}
1890		1936
1891	1	1937	1
1892	}	1938	}
1893		1939
…		…
1917	can_events => 1,	1963	can_events => 1,
1918	@_	1964	@_
1919	)	1965	)
1920	}	1966	}
1921		1967
1922	sub activate { }
1923
1924	sub button_up {	1968	sub invoke_button_up {
1925	my ($self, $ev, $x, $y) = @_;	1969	my ($self, $ev, $x, $y) = @_;
1926		1970
1927	$self->emit ("activate")	1971	$self->emit ("activate")
1928	if $x >= 0 && $x < $self->{w}	1972	if $x >= 0 && $x < $self->{w}
1929	&& $y >= 0 && $y < $self->{h};	1973	&& $y >= 0 && $y < $self->{h};
…		…
1943	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	1987	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1944		1988
1945	glDisable GL_TEXTURE_2D;	1989	glDisable GL_TEXTURE_2D;
1946		1990
1947	$self->SUPER::_draw;	1991	$self->SUPER::_draw;
		1992	}
		1993
		1994	#############################################################################
		1995
		1996	package CFClient::UI::ImageButton;
		1997
		1998	our @ISA = CFClient::UI::Image::;
		1999
		2000	use CFClient::OpenGL;
		2001
		2002	my %textures;
		2003
		2004	sub new {
		2005	my $class = shift;
		2006
		2007	my $self = $class->SUPER::new (
		2008	padding_x => 4,
		2009	padding_y => 4,
		2010	fg => [1, 1, 1],
		2011	active_fg => [0, 0, 1],
		2012	can_hover => 1,
		2013	align => 0,
		2014	valign => 0,
		2015	can_events => 1,
		2016	@_
		2017	);
		2018	}
		2019
		2020	sub invoke_button_up {
		2021	my ($self, $ev, $x, $y) = @_;
		2022
		2023	$self->emit ("activate")
		2024	if $x >= 0 && $x < $self->{w}
		2025	&& $y >= 0 && $y < $self->{h};
		2026
		2027	1
1948	}	2028	}
1949		2029
1950	#############################################################################	2030	#############################################################################
1951		2031
1952	package CFClient::UI::CheckBox;	2032	package CFClient::UI::CheckBox;
…		…
1979	my ($self) = @_;	2059	my ($self) = @_;
1980		2060
1981	(6) x 2	2061	(6) x 2
1982	}	2062	}
1983		2063
1984	sub button_down {	2064	sub invoke_button_down {
1985	my ($self, $ev, $x, $y) = @_;	2065	my ($self, $ev, $x, $y) = @_;
1986		2066
1987	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2067	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1988	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2068	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1989	$self->{state} = !$self->{state};	2069	$self->{state} = !$self->{state};
1990	$self->_emit (changed => $self->{state});	2070	$self->emit (changed => $self->{state});
1991	} else {	2071	} else {
1992	return 0	2072	return 0
1993	}	2073	}
1994		2074
1995	1	2075	1
…		…
2020	package CFClient::UI::Image;	2100	package CFClient::UI::Image;
2021		2101
2022	our @ISA = CFClient::UI::Base::;	2102	our @ISA = CFClient::UI::Base::;
2023		2103
2024	use CFClient::OpenGL;	2104	use CFClient::OpenGL;
2025	use Carp qw/confess/;
2026		2105
2027	our %loaded_images;	2106	our %texture_cache;
2028		2107
2029	sub new {	2108	sub new {
2030	my $class = shift;	2109	my $class = shift;
2031		2110
2032	my $self = $class->SUPER::new (can_events => 0, @_);	2111	my $self = $class->SUPER::new (
		2112	can_events => 0,
		2113	@_,
		2114	);
2033		2115
2034	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2116	$self->{path}
		2117	or Carp::croak "required attribute 'path' not set";
2035		2118
2036	$loaded_images{$self->{image}} ||=	2119	$self->{tex} = $texture_cache{$self->{path}} ||=
2037	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2120	new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2038		2121
2039	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2122	Scalar::Util::weaken $texture_cache{$self->{path}};
2040		2123
2041	Scalar::Util::weaken $loaded_images{$self->{image}};	2124	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2042
2043	$self->{aspect} = $tex->{w} / $tex->{h};
2044		2125
2045	$self	2126	$self
2046	}	2127	}
2047		2128
2048	sub size_request {	2129	sub size_request {
2049	my ($self) = @_;	2130	my ($self) = @_;
2050		2131
2051	($self->{tex}->{w}, $self->{tex}->{h})	2132	($self->{tex}{w}, $self->{tex}{h})
2052	}	2133	}
2053		2134
2054	sub _draw {	2135	sub _draw {
2055	my ($self) = @_;	2136	my ($self) = @_;
2056		2137
…		…
2292	$self->update;	2373	$self->update;
2293		2374
2294	$self	2375	$self
2295	}	2376	}
2296		2377
2297	sub changed { }
2298
2299	sub set_range {	2378	sub set_range {
2300	my ($self, $range) = @_;	2379	my ($self, $range) = @_;
2301		2380
2302	($range, $self->{range}) = ($self->{range}, $range);	2381	($range, $self->{range}) = ($self->{range}, $range);
2303		2382
2304	$self->update
2305	if "@$range" ne "@{$self->{range}}";	2383	if ("@$range" ne "@{$self->{range}}") {
		2384	$self->update;
		2385	$self->set_value ($self->{range}[0]);
		2386	}
2306	}	2387	}
2307		2388
2308	sub set_value {	2389	sub set_value {
2309	my ($self, $value) = @_;	2390	my ($self, $value) = @_;
2310		2391
…		…
2321	if $unit;	2402	if $unit;
2322		2403
2323	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2404	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2324		2405
2325	if ($value != $old_value) {	2406	if ($value != $old_value) {
2326	$self->_emit (changed => $value);	2407	$self->emit (changed => $value);
2327	$self->update;	2408	$self->update;
2328	}	2409	}
2329	}	2410	}
2330		2411
2331	sub size_request {	2412	sub size_request {
2332	my ($self) = @_;	2413	my ($self) = @_;
2333		2414
2334	($self->{req_w}, $self->{req_h})	2415	($self->{req_w}, $self->{req_h})
2335	}	2416	}
2336		2417
2337	sub button_down {	2418	sub invoke_button_down {
2338	my ($self, $ev, $x, $y) = @_;	2419	my ($self, $ev, $x, $y) = @_;
2339		2420
2340	$self->SUPER::button_down ($ev, $x, $y);	2421	$self->SUPER::invoke_button_down ($ev, $x, $y);
2341		2422
2342	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2423	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2343		2424
2344	$self->mouse_motion ($ev, $x, $y)	2425	$self->invoke_mouse_motion ($ev, $x, $y)
2345	}	2426	}
2346		2427
2347	sub mouse_motion {	2428	sub invoke_mouse_motion {
2348	my ($self, $ev, $x, $y) = @_;	2429	my ($self, $ev, $x, $y) = @_;
2349		2430
2350	if ($GRAB == $self) {	2431	if ($GRAB == $self) {
2351	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2432	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2352		2433
…		…
2457	sub set_range { shift->{slider}->set_range (@_) }	2538	sub set_range { shift->{slider}->set_range (@_) }
2458	sub set_value { shift->{slider}->set_value (@_) }	2539	sub set_value { shift->{slider}->set_value (@_) }
2459		2540
2460	#############################################################################	2541	#############################################################################
2461		2542
2462	package CFClient::UI::TextView;	2543	package CFClient::UI::TextScroller;
2463		2544
2464	our @ISA = CFClient::UI::HBox::;	2545	our @ISA = CFClient::UI::HBox::;
2465		2546
2466	use CFClient::OpenGL;	2547	use CFClient::OpenGL;
2467		2548
…		…
2469	my $class = shift;	2550	my $class = shift;
2470		2551
2471	my $self = $class->SUPER::new (	2552	my $self = $class->SUPER::new (
2472	fontsize => 1,	2553	fontsize => 1,
2473	can_events => 0,	2554	can_events => 0,
		2555	indent => 0,
2474	#font => default_font	2556	#font => default_font
2475	@_,	2557	@_,
2476		2558
2477	layout => (new CFClient::Layout 1),	2559	layout => (new CFClient::Layout 1),
2478	par => [],	2560	par => [],
…		…
2493		2575
2494	$self->{fontsize} = $fontsize;	2576	$self->{fontsize} = $fontsize;
2495	$self->reflow;	2577	$self->reflow;
2496	}	2578	}
2497		2579
		2580	sub size_request {
		2581	my ($self) = @_;
		2582
		2583	my ($empty, $slider) = @{ $self->{children} };
		2584
		2585	local $self->{children} = [$empty, $slider];
		2586	$self->SUPER::size_request
		2587	}
		2588
2498	sub size_allocate {	2589	sub invoke_size_allocate {
2499	my ($self, $w, $h) = @_;	2590	my ($self, $w, $h) = @_;
2500		2591
2501	$self->SUPER::size_allocate ($w, $h);	2592	my ($empty, $slider, @other) = @{ $self->{children} };
		2593	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2502		2594
2503	$self->{layout}->set_font ($self->{font}) if $self->{font};	2595	$self->{layout}->set_font ($self->{font}) if $self->{font};
2504	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2596	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2505	$self->{layout}->set_width ($self->{children}[0]{w});	2597	$self->{layout}->set_width ($empty->{w});
		2598	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2506		2599
2507	$self->reflow;	2600	$self->reflow;
2508	}
2509		2601
2510	sub text_size {	2602	local $self->{children} = [$empty, $slider];
2511	my ($self, $text, $indent) = @_;	2603	$self->SUPER::invoke_size_allocate ($w, $h)
		2604	}
		2605
		2606	sub get_layout {
		2607	my ($self, $para) = @_;
2512		2608
2513	my $layout = $self->{layout};	2609	my $layout = $self->{layout};
2514		2610
		2611	$layout->set_font ($self->{font}) if $self->{font};
		2612	$layout->set_foreground (@{$para->{fg}});
2515	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2613	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2516	$layout->set_width ($self->{children}[0]{w} - $indent);	2614	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
		2615	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2517	$layout->set_markup ($text);	2616	$layout->set_markup ($para->{markup});
		2617
		2618	$layout->set_shapes (
		2619	map
		2620	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		2621	@{$para->{widget}}
2518		2622	);
		2623
2519	$layout->size	2624	$layout
2520	}	2625	}
2521		2626
2522	sub reflow {	2627	sub reflow {
2523	my ($self) = @_;	2628	my ($self) = @_;
2524		2629
…		…
2533	$self->{children}[1]->set_value ($offset);	2638	$self->{children}[1]->set_value ($offset);
2534	}	2639	}
2535		2640
2536	sub clear {	2641	sub clear {
2537	my ($self) = @_;	2642	my ($self) = @_;
		2643
		2644	my (undef, undef, @other) = @{ $self->{children} };
		2645	$self->remove ($_) for @other;
2538		2646
2539	$self->{par} = [];	2647	$self->{par} = [];
2540	$self->{height} = 0;	2648	$self->{height} = 0;
2541	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2649	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2542	}	2650	}
2543		2651
2544	sub add_paragraph {	2652	sub add_paragraph {
2545	my ($self, $color, $text, $indent) = @_;	2653	my ($self, $color, $para, $indent) = @_;
2546		2654
2547	for my $line (split /\n/, $text) {	2655	my ($text, @w) = ref $para ? @$para : $para;
2548	my ($w, $h) = $self->text_size ($line);	2656
2549	$self->{height} += $h;	2657	$para = {
2550	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	2658	w => 1e10,
		2659	wrapped => 1,
		2660	fg => $color,
		2661	indent => $indent,
		2662	markup => $text,
		2663	widget => \@w,
2551	}	2664	};
2552		2665
2553	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	2666	$self->add (@w) if @w;
		2667	push @{$self->{par}}, $para;
		2668
		2669	$self->{need_reflow}++;
		2670	$self->update;
		2671	}
		2672
		2673	sub scroll_to_bottom {
		2674	my ($self) = @_;
		2675
		2676	$self->{scroll_to_bottom} = 1;
		2677	$self->update;
2554	}	2678	}
2555		2679
2556	sub update {	2680	sub update {
2557	my ($self) = @_;	2681	my ($self) = @_;
2558		2682
…		…
2560		2684
2561	return unless $self->{h} > 0;	2685	return unless $self->{h} > 0;
2562		2686
2563	delete $self->{texture};	2687	delete $self->{texture};
2564		2688
2565	$ROOT->on_post_alloc ($self, sub {	2689	$ROOT->on_post_alloc ($self => sub {
2566	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2690	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2567		2691
2568	if (delete $self->{need_reflow}) {	2692	if (delete $self->{need_reflow}) {
2569	my $height = 0;	2693	my $height = 0;
2570		2694
2571	my $layout = $self->{layout};
2572
2573	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2574
2575	for (@{$self->{par}}) {	2695	for my $para (@{$self->{par}}) {
2576	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2696	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2577	$layout->set_width ($W - $_->[3]);	2697	my $layout = $self->get_layout ($para);
2578	$layout->set_markup ($_->[4]);
2579	my ($w, $h) = $layout->size;	2698	my ($w, $h) = $layout->size;
2580	$_->[0] = $w + $_->[3];	2699
2581	$_->[1] = $h;	2700	$para->{w} = $w + $para->{indent};
		2701	$para->{h} = $h;
		2702	$para->{wrapped} = $layout->has_wrapped;
2582	}	2703	}
2583		2704
2584	$height += $_->[1];	2705	$height += $para->{h};
2585	}	2706	}
2586		2707
2587	$self->{height} = $height;	2708	$self->{height} = $height;
2588		2709
2589	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2710	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2590		2711
2591	delete $self->{texture};	2712	delete $self->{texture};
		2713	}
		2714
		2715	if (delete $self->{scroll_to_bottom}) {
		2716	$self->{children}[1]->set_value (1e10);
2592	}	2717	}
2593		2718
2594	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2719	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2595	glClearColor 0, 0, 0, 0;	2720	glClearColor 0, 0, 0, 0;
2596	glClear GL_COLOR_BUFFER_BIT;	2721	glClear GL_COLOR_BUFFER_BIT;
…		…
2600	my $y0 = $top;	2725	my $y0 = $top;
2601	my $y1 = $top + $H;	2726	my $y1 = $top + $H;
2602		2727
2603	my $y = 0;	2728	my $y = 0;
2604		2729
2605	my $layout = $self->{layout};
2606
2607	$layout->set_font ($self->{font}) if $self->{font};
2608
2609	glEnable GL_BLEND;	2730	glEnable GL_BLEND;
2610	#TODO# not correct in windows where rgba is forced off	2731	#TODO# not correct in windows where rgba is forced off
2611	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2732	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2612		2733
2613	for my $par (@{$self->{par}}) {	2734	for my $para (@{$self->{par}}) {
2614	my $h = $par->[1];	2735	my $h = $para->{h};
2615		2736
2616	if ($y0 < $y + $h && $y < $y1) {	2737	if ($y0 < $y + $h && $y < $y1) {
2617	$layout->set_foreground (@{ $par->[2] });	2738
2618	$layout->set_width ($W - $par->[3]);	2739	my $layout = $self->get_layout ($para);
2619	$layout->set_markup ($par->[4]);
2620		2740
2621	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2741	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2622		2742
2623	glRasterPos $par->[3], $y - $y0;	2743	glRasterPos $para->{indent}, $y - $y0;
2624	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	2744	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
		2745
		2746	if (my @w = @{ $para->{widget} }) {
		2747	my @s = $layout->get_shapes;
		2748
		2749	glDisable GL_BLEND;
		2750	for (@w) {
		2751	my ($dx, $dy) = splice @s, 0, 2, ();
		2752
		2753	$_->{x} = $dx + $para->{indent};
		2754	$_->{y} = $dy + $y - $y0;
		2755
		2756	$_->draw;
		2757	}
		2758	glEnable GL_BLEND;
		2759	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
		2760	}
2625	}	2761	}
2626		2762
2627	$y += $h;	2763	$y += $h;
2628	}	2764	}
2629		2765
2630	glDisable GL_BLEND;	2766	glDisable GL_BLEND;
2631	};	2767	};
2632	});	2768	});
		2769	}
		2770
		2771	sub reconfigure {
		2772	my ($self) = @_;
		2773
		2774	$self->SUPER::reconfigure;
		2775
		2776	$_->{w} = 1e10 for @{ $self->{par} };
		2777	$self->reflow;
2633	}	2778	}
2634		2779
2635	sub _draw {	2780	sub _draw {
2636	my ($self) = @_;	2781	my ($self) = @_;
2637		2782
…		…
2640	glColor 0, 0, 0, 1;	2785	glColor 0, 0, 0, 1;
2641	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2786	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2642	glDisable GL_TEXTURE_2D;	2787	glDisable GL_TEXTURE_2D;
2643		2788
2644	$self->{children}[1]->draw;	2789	$self->{children}[1]->draw;
2645
2646	}	2790	}
2647		2791
2648	#############################################################################	2792	#############################################################################
2649		2793
2650	package CFClient::UI::Animator;	2794	package CFClient::UI::Animator;
…		…
2737	$tooltip .= "\n\n" . (ref $widget) . "\n"	2881	$tooltip .= "\n\n" . (ref $widget) . "\n"
2738	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	2882	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2739	. "req $widget->{req_w} $widget->{req_h}\n"	2883	. "req $widget->{req_w} $widget->{req_h}\n"
2740	. "visible $widget->{visible}";	2884	. "visible $widget->{visible}";
2741	}	2885	}
		2886
		2887	$tooltip =~ s/^\n+//;
		2888	$tooltip =~ s/\n+$//;
2742		2889
2743	$self->add (new CFClient::UI::Label	2890	$self->add (new CFClient::UI::Label
2744	markup => $tooltip,	2891	markup => $tooltip,
2745	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2892	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2746	fontsize => 0.8,	2893	fontsize => 0.8,
…		…
2756	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2903	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2757		2904
2758	($w + 4, $h + 4)	2905	($w + 4, $h + 4)
2759	}	2906	}
2760		2907
2761	sub size_allocate {	2908	sub invoke_size_allocate {
2762	my ($self, $w, $h) = @_;	2909	my ($self, $w, $h) = @_;
2763		2910
2764	$self->SUPER::size_allocate ($w - 4, $h - 4);	2911	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2765	}	2912	}
2766		2913
2767	sub visibility_change {	2914	sub invoke_visibility_change {
2768	my ($self, $visible) = @_;	2915	my ($self, $visible) = @_;
2769		2916
2770	return unless $visible;	2917	return unless $visible;
2771		2918
2772	$self->{root}->on_post_alloc ("move_$self" => sub {	2919	$self->{root}->on_post_alloc ("move_$self" => sub {
…		…
2774	or return;	2921	or return;
2775		2922
2776	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2923	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2777		2924
2778	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2925	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2779	if $x + $self->{w} > $::WIDTH;	2926	if $x + $self->{w} > $self->{root}{w};
2780		2927
2781	$self->move_abs ($x, $y);	2928	$self->move_abs ($x, $y);
2782	});	2929	});
2783	}	2930	}
2784		2931
…		…
2879	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3026	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2880	glDisable GL_TEXTURE_2D;	3027	glDisable GL_TEXTURE_2D;
2881	}	3028	}
2882	}	3029	}
2883		3030
2884	sub DESTROY {	3031	sub destroy {
2885	my ($self) = @_;	3032	my ($self) = @_;
2886		3033
2887	$self->{timer}->cancel	3034	$self->{timer}->cancel
2888	if $self->{timer};	3035	if $self->{timer};
2889		3036
2890	$self->SUPER::DESTROY;	3037	$self->SUPER::destroy;
2891	}	3038	}
2892		3039
2893	#############################################################################	3040	#############################################################################
2894		3041
2895	package CFClient::UI::Buttonbar;	3042	package CFClient::UI::Buttonbar;
…		…
2916	);	3063	);
2917		3064
2918	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3065	$self->add ($self->{vbox} = new CFClient::UI::VBox);
2919		3066
2920	for my $item (@{ $self->{items} }) {	3067	for my $item (@{ $self->{items} }) {
2921	my ($widget, $cb) = @$item;	3068	my ($widget, $cb, $tooltip) = @$item;
2922		3069
2923	# handle various types of items, only text for now	3070	# handle various types of items, only text for now
2924	if (!ref $widget) {	3071	if (!ref $widget) {
2925	$widget = new CFClient::UI::Label	3072	$widget = new CFClient::UI::Label
2926	can_hover => 1,	3073	can_hover => 1,
2927	can_events => 1,	3074	can_events => 1,
2928	text => $widget;	3075	markup => $widget,
		3076	tooltip => $tooltip
2929	}	3077	}
2930		3078
2931	$self->{item}{$widget} = $item;	3079	$self->{item}{$widget} = $item;
2932		3080
2933	$self->{vbox}->add ($widget);	3081	$self->{vbox}->add ($widget);
…		…
2938		3086
2939	# popup given the event (must be a mouse button down event currently)	3087	# popup given the event (must be a mouse button down event currently)
2940	sub popup {	3088	sub popup {
2941	my ($self, $ev) = @_;	3089	my ($self, $ev) = @_;
2942		3090
2943	$self->_emit ("popdown");	3091	$self->emit ("popdown");
2944		3092
2945	# maybe save $GRAB? must be careful about events...	3093	# maybe save $GRAB? must be careful about events...
2946	$GRAB = $self;	3094	$GRAB = $self;
2947	$self->{button} = $ev->{button};	3095	$self->{button} = $ev->{button};
2948		3096
2949	$self->show;	3097	$self->show;
2950	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3098	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2951	}	3099	}
2952		3100
2953	sub mouse_motion {	3101	sub invoke_mouse_motion {
2954	my ($self, $ev, $x, $y) = @_;	3102	my ($self, $ev, $x, $y) = @_;
2955		3103
2956	# TODO: should use vbox->find_widget or so	3104	# TODO: should use vbox->find_widget or so
2957	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3105	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2958	$self->{hover} = $self->{item}{$HOVER};	3106	$self->{hover} = $self->{item}{$HOVER};
2959		3107
2960	0	3108	0
2961	}	3109	}
2962		3110
2963	sub button_up {	3111	sub invoke_button_up {
2964	my ($self, $ev, $x, $y) = @_;	3112	my ($self, $ev, $x, $y) = @_;
2965		3113
2966	if ($ev->{button} == $self->{button}) {	3114	if ($ev->{button} == $self->{button}) {
2967	undef $GRAB;	3115	undef $GRAB;
2968	$self->hide;	3116	$self->hide;
2969		3117
2970	$self->_emit ("popdown");	3118	$self->emit ("popdown");
2971	$self->{hover}[1]->() if $self->{hover};	3119	$self->{hover}[1]->() if $self->{hover};
2972	} else {	3120	} else {
2973	return 0	3121	return 0
2974	}	3122	}
2975		3123
…		…
3012	: $self->{children}[$page_or_widget];	3160	: $self->{children}[$page_or_widget];
3013		3161
3014	$self->{current} = $widget;	3162	$self->{current} = $widget;
3015	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3163	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3016		3164
3017	$self->_emit (page_changed => $self->{current});	3165	$self->emit (page_changed => $self->{current});
3018		3166
3019	$self->realloc;	3167	$self->realloc;
3020	}	3168	}
3021		3169
3022	sub visible_children {	3170	sub visible_children {
…		…
3027	my ($self) = @_;	3175	my ($self) = @_;
3028		3176
3029	$self->{current}->size_request	3177	$self->{current}->size_request
3030	}	3178	}
3031		3179
3032	sub size_allocate {	3180	sub invoke_size_allocate {
3033	my ($self, $w, $h) = @_;	3181	my ($self, $w, $h) = @_;
3034		3182
3035	$self->{current}->configure (0, 0, $w, $h);	3183	$self->{current}->configure (0, 0, $w, $h);
		3184
		3185	1
3036	}	3186	}
3037		3187
3038	sub _draw {	3188	sub _draw {
3039	my ($self) = @_;	3189	my ($self) = @_;
3040		3190
…		…
3079		3229
3080	sub set_current_page {	3230	sub set_current_page {
3081	my ($self, $page) = @_;	3231	my ($self, $page) = @_;
3082		3232
3083	$self->{multiplexer}->set_current_page ($page);	3233	$self->{multiplexer}->set_current_page ($page);
3084	$self->_emit (page_changed => $self->{multiplexer}{current});	3234	$self->emit (page_changed => $self->{multiplexer}{current});
		3235	}
		3236
		3237	#############################################################################
		3238
		3239	package CFClient::UI::Combobox;
		3240
		3241	use utf8;
		3242
		3243	our @ISA = CFClient::UI::Button::;
		3244
		3245	sub new {
		3246	my $class = shift;
		3247
		3248	my $self = $class->SUPER::new (
		3249	options => [], # [value, title, longdesc], ...
		3250	value => undef,
		3251	@_,
		3252	);
		3253
		3254	$self->_set_value ($self->{value});
		3255
		3256	$self
		3257	}
		3258
		3259	sub invoke_button_down {
		3260	my ($self, $ev) = @_;
		3261
		3262	my @menu_items;
		3263
		3264	for (@{ $self->{options} }) {
		3265	my ($value, $title, $tooltip) = @$_;
		3266
		3267	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3268	}
		3269
		3270	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3271	}
		3272
		3273	sub _set_value {
		3274	my ($self, $value) = @_;
		3275
		3276	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3277	or return;
		3278
		3279	$self->{value} = $item->[0];
		3280	$self->set_markup ("$item->[1] ⇓");
		3281	$self->set_tooltip ($item->[2]);
		3282	}
		3283
		3284	sub set_value {
		3285	my ($self, $value) = @_;
		3286
		3287	return unless $self->{value} ne $value;
		3288
		3289	$self->_set_value ($value);
		3290	$self->emit (changed => $value);
3085	}	3291	}
3086		3292
3087	#############################################################################	3293	#############################################################################
3088		3294
3089	package CFClient::UI::Statusbox;	3295	package CFClient::UI::Statusbox;
…		…
3188	$item->{count}++;	3394	$item->{count}++;
3189	} else {	3395	} else {
3190	$item->{count} = 1;	3396	$item->{count} = 1;
3191	$item->{text} = $item->{tooltip} = $text;	3397	$item->{text} = $item->{tooltip} = $text;
3192	}	3398	}
3193	$item->{id} = ++$self->{id};	3399	$item->{id} += 0.2;#d#
3194	$item->{timeout} = $timeout;	3400	$item->{timeout} = $timeout;
3195	delete $item->{label};	3401	delete $item->{label};
3196	} else {	3402	} else {
3197	$self->{item}{$group} = {	3403	$self->{item}{$group} = {
3198	id => ++$self->{id},	3404	id => ++$self->{id},
…		…
3217		3423
3218	$self->reorder;	3424	$self->reorder;
3219	$self->SUPER::reconfigure;	3425	$self->SUPER::reconfigure;
3220	}	3426	}
3221		3427
3222	sub DESTROY {	3428	sub destroy {
3223	my ($self) = @_;	3429	my ($self) = @_;
3224		3430
3225	$self->{timer}->cancel;	3431	$self->{timer}->cancel;
3226		3432
3227	$self->SUPER::DESTROY;	3433	$self->SUPER::destroy;
3228	}	3434	}
3229		3435
3230	#############################################################################	3436	#############################################################################
3231		3437
3232	package CFClient::UI::Inventory;	3438	package CFClient::UI::Inventory;
…		…
3264	$self->{child}->add (0, $row, $item->{face_widget});	3470	$self->{child}->add (0, $row, $item->{face_widget});
3265	$self->{child}->add (1, $row, $item->{desc_widget});	3471	$self->{child}->add (1, $row, $item->{desc_widget});
3266	$self->{child}->add (2, $row, $item->{weight_widget});	3472	$self->{child}->add (2, $row, $item->{weight_widget});
3267		3473
3268	$row++;	3474	$row++;
3269	}
3270	}
3271
3272	#############################################################################
3273
3274	package CFClient::UI::BindEditor;
3275
3276	our @ISA = CFClient::UI::FancyFrame::;
3277
3278	sub new {
3279	my $class = shift;
3280
3281	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3282
3283	$self->add (my $vb = new CFClient::UI::VBox);
3284
3285
3286	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3287	text => "start recording",
3288	tooltip => "Start/Stops recording of actions."
3289	."All subsequent actions after the recording started will be captured."
3290	."The actions are displayed after the record was stopped."
3291	."To bind the action you have to click on the 'Bind' button",
3292	on_activate => sub {
3293	unless ($self->{recording}) {
3294	$self->start;
3295	} else {
3296	$self->stop;
3297	}
3298	});
3299
3300	$vb->add (new CFClient::UI::Label text => "Actions:");
3301	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3302
3303	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3304	$vb->add (my $hb = new CFClient::UI::HBox);
3305	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3306	$hb->add (new CFClient::UI::Button
3307	text => "bind",
3308	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3309	on_activate => sub {
3310	$self->ask_for_bind;
3311	});
3312
3313	$vb->add (my $hb = new CFClient::UI::HBox);
3314	$hb->add (new CFClient::UI::Button
3315	text => "ok",
3316	expand => 1,
3317	tooltip => "This closes the binding editor and saves the binding",
3318	on_activate => sub {
3319	$self->hide;
3320	$self->commit;
3321	});
3322
3323	$hb->add (new CFClient::UI::Button
3324	text => "cancel",
3325	expand => 1,
3326	tooltip => "This closes the binding editor without saving",
3327	on_activate => sub {
3328	$self->hide;
3329	$self->{binding_cancel}->()
3330	if $self->{binding_cancel};
3331	});
3332
3333	$self->update_binding_widgets;
3334
3335	$self
3336	}
3337
3338	sub commit {
3339	my ($self) = @_;
3340	my ($mod, $sym, $cmds) = $self->get_binding;
3341	if ($sym != 0 && @$cmds > 0) {
3342	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3343	."'. Don't forget 'Save Config'!");
3344	$self->{binding_change}->($mod, $sym, $cmds)
3345	if $self->{binding_change};
3346	} else {
3347	$::STATUSBOX->add ("No action bound, no key or action specified!");
3348	$self->{binding_cancel}->()
3349	if $self->{binding_cancel};
3350	}
3351	}
3352
3353	sub start {
3354	my ($self) = @_;
3355
3356	$self->{rec_btn}->set_text ("stop recording");
3357	$self->{recording} = 1;
3358	$self->clear_command_list;
3359	$::CONN->start_record if $::CONN;
3360	}
3361
3362	sub stop {
3363	my ($self) = @_;
3364
3365	$self->{rec_btn}->set_text ("start recording");
3366	$self->{recording} = 0;
3367
3368	my $rec;
3369	$rec = $::CONN->stop_record if $::CONN;
3370	return unless ref $rec eq 'ARRAY';
3371	$self->set_command_list ($rec);
3372	}
3373
3374
3375	sub ask_for_bind_and_commit {
3376	my ($self) = @_;
3377	$self->ask_for_bind (1);
3378	}
3379
3380	sub ask_for_bind {
3381	my ($self, $commit) = @_;
3382
3383	CFClient::Binder::open_binding_dialog (sub {
3384	my ($mod, $sym) = @_;
3385	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3386	$self->update_binding_widgets;
3387	$self->commit if $commit;
3388	});
3389	}
3390
3391	# $mod and $sym are the modifiers and key symbol
3392	# $cmds is a array ref of strings (the commands)
3393	# $cb is the callback that is executed on OK
3394	# $ccb is the callback that is executed on CANCEL and
3395	# when the binding was unsuccessful on OK
3396	sub set_binding {
3397	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3398
3399	$self->clear_command_list;
3400	$self->{recording} = 0;
3401	$self->{rec_btn}->set_text ("start recording");
3402
3403	$self->{binding} = [$mod, $sym];
3404	$self->{commands} = $cmds;
3405
3406	$self->{binding_change} = $cb;
3407	$self->{binding_cancel} = $ccb;
3408
3409	$self->update_binding_widgets;
3410	}
3411
3412	# this is a shortcut method that asks for a binding
3413	# and then just binds it.
3414	sub do_quick_binding {
3415	my ($self, $cmds) = @_;
3416	$self->set_binding (undef, undef, $cmds, sub {
3417	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3418	});
3419	$self->ask_for_bind (1);
3420	}
3421
3422	sub update_binding_widgets {
3423	my ($self) = @_;
3424	my ($mod, $sym, $cmds) = $self->get_binding;
3425	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3426	$self->set_command_list ($cmds);
3427	}
3428
3429	sub get_binding {
3430	my ($self) = @_;
3431	return (
3432	$self->{binding}->[0],
3433	$self->{binding}->[1],
3434	[ grep { defined $_ } @{$self->{commands}} ]
3435	);
3436	}
3437
3438	sub clear_command_list {
3439	my ($self) = @_;
3440	$self->{cmdbox}->clear ();
3441	}
3442
3443	sub set_command_list {
3444	my ($self, $cmds) = @_;
3445
3446	$self->{cmdbox}->clear ();
3447	$self->{commands} = $cmds;
3448
3449	my $idx = 0;
3450
3451	for (@$cmds) {
3452	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3453
3454	my $i = $idx;
3455	$hb->add (new CFClient::UI::Label text => $_);
3456	$hb->add (new CFClient::UI::Button
3457	text => "delete",
3458	tooltip => "Deletes the action from the record",
3459	on_activate => sub {
3460	$self->{cmdbox}->remove ($hb);
3461	$cmds->[$i] = undef;
3462	});
3463
3464
3465	$idx++
3466	}	3475	}
3467	}	3476	}
3468		3477
3469	#############################################################################	3478	#############################################################################
3470		3479
…		…
3480	commands => [],	3489	commands => [],
3481	@_,	3490	@_,
3482	)	3491	)
3483	}	3492	}
3484		3493
3485	# XXX: Do sorting? Argl...	3494	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3495
		3496	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3497	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3498	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3499	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3500	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3501	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3502	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3503	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3504	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3505	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3506
		3507	sub rebuild_spell_list {
		3508	my ($self) = @_;
		3509
		3510	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3511	$self->clear;
		3512
		3513	return unless $::CONN;
		3514
		3515	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3516	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3517	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3518	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3519	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3520
		3521	my $row = 0;
		3522
		3523	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3524	my $spell = $self->{spell}{$_};
		3525
		3526	$row++;
		3527
		3528	my $spell_cb = sub {
		3529	my ($widget, $ev) = @_;
		3530
		3531	if ($ev->{button} == 1) {
		3532	$::CONN->user_send ("cast $spell->{name}");
		3533	} elsif ($ev->{button} == 2) {
		3534	$::CONN->user_send ("invoke $spell->{name}");
		3535	} elsif ($ev->{button} == 3) {
		3536	(new CFClient::UI::Menu
		3537	items => [
		3538	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3539	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3540	],
		3541	)->popup ($ev);
		3542	} else {
		3543	return 0;
		3544	}
		3545
		3546	1
		3547	};
		3548
		3549	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3550
		3551	#TODO: add path info to tooltip
		3552	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3553
		3554	$self->add (0, $row, new CFClient::UI::Face
		3555	face => $spell->{face},
		3556	can_hover => 1,
		3557	can_events => 1,
		3558	tooltip => $tooltip,
		3559	on_button_down => $spell_cb,
		3560	);
		3561
		3562	$self->add (1, $row, new CFClient::UI::Label
		3563	expand => 1,
		3564	text => $spell->{name},
		3565	can_hover => 1,
		3566	can_events => 1,
		3567	tooltip => $tooltip,
		3568	on_button_down => $spell_cb,
		3569	);
		3570
		3571	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3572	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3573	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3574	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3575	}
		3576	});
		3577	}
		3578
3486	sub add_spell {	3579	sub add_spell {
3487	my ($self, $spell) = @_;	3580	my ($self, $spell) = @_;
		3581
3488	$self->{spells}->{$spell->{name}} = $spell;	3582	$self->{spell}->{$spell->{name}} = $spell;
3489		3583	$self->rebuild_spell_list;
3490	$self->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3491	face => $spell->{face},
3492	can_hover => 1,
3493	can_events => 1,
3494	tooltip => $spell->{message});
3495
3496	$self->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3497	text => $spell->{name},
3498	can_hover => 1,
3499	can_events => 1,
3500	tooltip => $spell->{message},
3501	expand => 1);
3502
3503	$self->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3504	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3505	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3506	expand => 1);
3507
3508	$self->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3509	text => "bind to key",
3510	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3511	}
3512
3513	sub rebuild_spell_list {
3514	my ($self) = @_;
3515	$self->{tbl_idx} = 0;
3516	$self->add_spell ($_) for values %{$self->{spells}};
3517	}	3584	}
3518		3585
3519	sub remove_spell {	3586	sub remove_spell {
3520	my ($self, $spell) = @_;	3587	my ($self, $spell) = @_;
		3588
3521	delete $self->{spells}->{$spell->{name}};	3589	delete $self->{spell}->{$spell->{name}};
		3590	$self->rebuild_spell_list;
		3591	}
		3592
		3593	sub clear_spells {
		3594	my ($self) = @_;
		3595
		3596	$self->{spell} = {};
3522	$self->rebuild_spell_list;	3597	$self->rebuild_spell_list;
3523	}	3598	}
3524		3599
3525	#############################################################################	3600	#############################################################################
3526		3601
…		…
3563	$coord = $max - $size if $coord > $max - $size;	3638	$coord = $max - $size if $coord > $max - $size;
3564		3639
3565	int $coord + 0.5	3640	int $coord + 0.5
3566	}	3641	}
3567		3642
3568	sub size_allocate {	3643	sub invoke_size_allocate {
3569	my ($self, $w, $h) = @_;	3644	my ($self, $w, $h) = @_;
3570		3645
3571	for my $child ($self->children) {	3646	for my $child ($self->children) {
3572	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3647	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3573		3648
…		…
3577	$X = _to_pixel $X, $W, $self->{w};	3652	$X = _to_pixel $X, $W, $self->{w};
3578	$Y = _to_pixel $Y, $H, $self->{h};	3653	$Y = _to_pixel $Y, $H, $self->{h};
3579		3654
3580	$child->configure ($X, $Y, $W, $H);	3655	$child->configure ($X, $Y, $W, $H);
3581	}	3656	}
		3657
		3658	1
3582	}	3659	}
3583		3660
3584	sub coord2local {	3661	sub coord2local {
3585	my ($self, $x, $y) = @_;	3662	my ($self, $x, $y) = @_;
3586		3663

Diff Legend

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