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.331 by root, Sun Jul 23 04:46:02 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 {
…		…
408		429
409	# translate global coordinates to local coordinate system	430	# translate global coordinates to local coordinate system
410	sub coord2local {	431	sub coord2local {
411	my ($self, $x, $y) = @_;	432	my ($self, $x, $y) = @_;
412		433
		434	Carp::confess unless $self->{parent};#d#
		435
413	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})	436	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
414	}	437	}
415		438
416	# translate local coordinates to global coordinate system	439	# translate local coordinates to global coordinate system
417	sub coord2global {	440	sub coord2global {
418	my ($self, $x, $y) = @_;	441	my ($self, $x, $y) = @_;
419		442
420	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	443	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421	}	444	}
422		445
423	sub focus_in {	446	sub invoke_focus_in {
424	my ($self) = @_;	447	my ($self) = @_;
425		448
426	return if $FOCUS == $self;	449	return if $FOCUS == $self;
427	return unless $self->{can_focus};	450	return unless $self->{can_focus};
428		451
429	my $focus = $FOCUS; $FOCUS = $self;	452	$FOCUS = $self;
430		453
431	$self->_emit (focus_in => $focus);	454	$self->update;
432		455
433	$focus->update if $focus;	456	0
434	$FOCUS->update;
435	}	457	}
436		458
437	sub focus_out {	459	sub invoke_focus_out {
438	my ($self) = @_;	460	my ($self) = @_;
439		461
440	return unless $FOCUS == $self;	462	return unless $FOCUS == $self;
441		463
442	my $focus = $FOCUS; undef $FOCUS;	464	undef $FOCUS;
443		465
444	$self->_emit (focus_out => $focus);	466	$self->update;
445		467
446	$focus->update if $focus; #?
447
448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	468	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449	unless $FOCUS;	469	unless $FOCUS;
450	}
451		470
		471	0
		472	}
		473
		474	sub grab_focus {
		475	my ($self) = @_;
		476
		477	$FOCUS->emit ("focus_out") if $FOCUS;
		478	$self->emit ("focus_in");
		479	}
		480
452	sub mouse_motion { 0 }	481	sub invoke_mouse_motion { 0 }
453	sub button_up { 0 }	482	sub invoke_button_up { 0 }
454	sub key_down { 0 }	483	sub invoke_key_down { 0 }
455	sub key_up { 0 }	484	sub invoke_key_up { 0 }
		485	sub invoke_mouse_wheel { 0 }
456		486
457	sub button_down {	487	sub invoke_button_down {
458	my ($self, $ev, $x, $y) = @_;	488	my ($self, $ev, $x, $y) = @_;
459		489
460	$self->focus_in;	490	$self->grab_focus;
461		491
462	0	492	0
		493	}
		494
		495	sub connect {
		496	my ($self, $signal, $cb) = @_;
		497
		498	push @{ $self->{signal_cb}{$signal} }, $cb;
		499	}
		500
		501	my %has_coords = (
		502	button_down => 1,
		503	button_up => 1,
		504	mouse_motion => 1,
		505	mouse_wheel => 1,
		506	);
		507
		508	sub emit {
		509	my ($self, $signal, @args) = @_;
		510
		511	my @append
		512	= $has_coords{$signal}
		513	? $args[0]->xy ($self)
		514	: ();
		515
		516	#warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
		517
		518	#d##TODO# stop propagating at first true, do not use sum
		519	(List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
		520	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append) # closure
		521	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
463	}	522	}
464		523
465	sub find_widget {	524	sub find_widget {
466	my ($self, $x, $y) = @_;	525	my ($self, $x, $y) = @_;
467		526
…		…
477	sub set_parent {	536	sub set_parent {
478	my ($self, $parent) = @_;	537	my ($self, $parent) = @_;
479		538
480	Scalar::Util::weaken ($self->{parent} = $parent);	539	Scalar::Util::weaken ($self->{parent} = $parent);
481	$self->set_visible if $parent->{visible};	540	$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	}	541	}
506		542
507	sub realloc {	543	sub realloc {
508	my ($self) = @_;	544	my ($self) = @_;
509		545
…		…
542	return unless $self->{h} && $self->{w};	578	return unless $self->{h} && $self->{w};
543		579
544	# update screen rectangle	580	# update screen rectangle
545	local $draw_x = $draw_x + $self->{x};	581	local $draw_x = $draw_x + $self->{x};
546	local $draw_y = $draw_y + $self->{y};	582	local $draw_y = $draw_y + $self->{y};
547	local $draw_w = $draw_x + $self->{w};
548	local $draw_h = $draw_y + $self->{h};
549		583
550	# skip widgets that are entirely outside the drawing area	584	# skip widgets that are entirely outside the drawing area
551	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)	585	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
552	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);	586	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
553		587
…		…
592	}	626	}
593		627
594	sub DESTROY {	628	sub DESTROY {
595	my ($self) = @_;	629	my ($self) = @_;
596		630
		631	return if CFClient::in_destruct;
		632
597	delete $WIDGET{$self+0};	633	delete $WIDGET{$self+0};
598	#$self->deactivate;	634
		635	eval { $self->destroy };
		636	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
599	}	637	}
600		638
601	#############################################################################	639	#############################################################################
602		640
603	package CFClient::UI::DrawBG;	641	package CFClient::UI::DrawBG;
…		…
768	}	806	}
769		807
770	sub add {	808	sub add {
771	my ($self, $child) = @_;	809	my ($self, $child) = @_;
772		810
773	$self->{children} = [];	811	$self->SUPER::remove ($_) for @{ $self->{children} };
774
775	$self->SUPER::add ($child);	812	$self->SUPER::add ($child);
776	}	813	}
777		814
778	sub remove {	815	sub remove {
779	my ($self, $widget) = @_;	816	my ($self, $widget) = @_;
…		…
788		825
789	sub size_request {	826	sub size_request {
790	$_[0]{children}[0]->size_request	827	$_[0]{children}[0]->size_request
791	}	828	}
792		829
793	sub size_allocate {	830	sub invoke_size_allocate {
794	my ($self, $w, $h) = @_;	831	my ($self, $w, $h) = @_;
795		832
796	$self->{children}[0]->configure (0, 0, $w, $h);	833	$self->{children}[0]->configure (0, 0, $w, $h);
		834
		835	1
797	}	836	}
798		837
799	#############################################################################	838	#############################################################################
800		839
801	# back-buffered drawing area	840	# back-buffered drawing area
…		…
817		856
818	$ROOT->on_post_alloc ($self => sub { $self->render_child });	857	$ROOT->on_post_alloc ($self => sub { $self->render_child });
819	$self->SUPER::update;	858	$self->SUPER::update;
820	}	859	}
821		860
822	sub size_allocate {	861	sub invoke_size_allocate {
823	my ($self, $w, $h) = @_;	862	my ($self, $w, $h) = @_;
824		863
825	$self->SUPER::size_allocate ($w, $h);
826	$self->update;	864	$self->update;
		865
		866	$self->SUPER::invoke_size_allocate ($w, $h)
827	}	867	}
828		868
829	sub _render {	869	sub _render {
830	my ($self) = @_;	870	my ($self) = @_;
831		871
…		…
892	$h = 10 if $self->{scroll_y};	932	$h = 10 if $self->{scroll_y};
893		933
894	($w, $h)	934	($w, $h)
895	}	935	}
896		936
897	sub size_allocate {	937	sub invoke_size_allocate {
898	my ($self, $w, $h) = @_;	938	my ($self, $w, $h) = @_;
899		939
900	my $child = $self->child;	940	my $child = $self->child;
901		941
902	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};	942	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
903	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};	943	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
904		944
905	$self->child->configure (0, 0, $w, $h);	945	$self->child->configure (0, 0, $w, $h);
906	$self->update;	946	$self->update;
		947
		948	1
907	}	949	}
908		950
909	sub set_offset {	951	sub set_offset {
910	my ($self, $x, $y) = @_;	952	my ($self, $x, $y) = @_;
911		953
…		…
974	$self->{vp}->set_offset (0, $_[1]);	1016	$self->{vp}->set_offset (0, $_[1]);
975	},	1017	},
976	;	1018	;
977		1019
978	$self = $class->SUPER::new (	1020	$self = $class->SUPER::new (
979	vp => (new CFClient::UI::ViewPort expand => 1),	1021	vp => (new CFClient::UI::ViewPort expand => 1),
		1022	can_events => 1,
980	slider => $slider,	1023	slider => $slider,
981	%arg,	1024	%arg,
982	);	1025	);
983		1026
984	$self->SUPER::add ($self->{vp}, $self->{slider});	1027	$self->SUPER::add ($self->{vp}, $self->{slider});
985	$self->add ($child) if $child;	1028	$self->add ($child) if $child;
986		1029
987	$self	1030	$self
988	}	1031	}
989		1032
		1033	#TODO# update range on size_allocate depending on child
		1034
990	sub add {	1035	sub add {
991	my ($self, $widget) = @_;	1036	my ($self, $widget) = @_;
992		1037
993	$self->{vp}->add ($self->{child} = $widget);	1038	$self->{vp}->add ($self->{child} = $widget);
994	}	1039	}
995		1040
		1041	sub invoke_mouse_wheel {
		1042	my ($self, $ev) = @_;
		1043
		1044	return 0 unless $ev->{dy}; # only vertical movements
		1045
		1046	$self->{slider}->emit (mouse_wheel => $ev);
		1047
		1048	1
		1049	}
		1050
		1051	sub update_slider {
		1052	my ($self) = @_;
		1053
		1054	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
		1055	}
		1056
996	sub update {	1057	sub update {
997	my ($self) = @_;	1058	my ($self) = @_;
998		1059
999	$self->SUPER::update;	1060	$self->SUPER::update;
1000		1061
1001	# todo: overwrite size_allocate of child	1062	$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	}	1063	}
1005		1064
1006	sub size_allocate {	1065	sub invoke_size_allocate {
1007	my ($self, $w, $h) = @_;	1066	my ($self, $w, $h) = @_;
1008		1067
		1068	$self->update_slider;
		1069
1009	$self->SUPER::size_allocate ($w, $h);	1070	$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	}	1071	}
1014
1015	#TODO# update range on size_allocate depending on child
1016	# update viewport offset on scroll
1017		1072
1018	#############################################################################	1073	#############################################################################
1019		1074
1020	package CFClient::UI::Frame;	1075	package CFClient::UI::Frame;
1021		1076
…		…
1072	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1127	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1073		1128
1074	sub new {	1129	sub new {
1075	my ($class, %arg) = @_;	1130	my ($class, %arg) = @_;
1076		1131
1077	my $title = delete $arg{title};
1078
1079	my $self = $class->SUPER::new (	1132	my $self = $class->SUPER::new (
1080	bg => [1, 1, 1, 1],	1133	bg => [1, 1, 1, 1],
1081	border_bg => [1, 1, 1, 1],	1134	border_bg => [1, 1, 1, 1],
1082	border => 0.6,	1135	border => 0.6,
1083	can_events => 1,	1136	can_events => 1,
1084	min_w => 16,	1137	min_w => 64,
1085	min_h => 16,	1138	min_h => 32,
1086	%arg,	1139	%arg,
1087	);	1140	);
1088		1141
1089	$self->{title} = new CFClient::UI::Label	1142	$self->{title_widget} = new CFClient::UI::Label
1090	align => 0,	1143	align => 0,
1091	valign => 1,	1144	valign => 1,
1092	text => $title,	1145	text => $self->{title},
1093	fontsize => $self->{border}	1146	fontsize => $self->{border},
1094	if defined $title;	1147	if exists $self->{title};
		1148
		1149	if ($self->{has_close_button}) {
		1150	$self->{close_button} =
		1151	new CFClient::UI::ImageButton
		1152	path => 'x1_close.png',
		1153	on_activate => sub { $self->emit ("delete") };
		1154
		1155	$self->CFClient::UI::Container::add ($self->{close_button});
		1156	}
1095		1157
1096	$self	1158	$self
1097	}	1159	}
1098		1160
1099	sub add {	1161	sub add {
1100	my ($self, @widgets) = @_;	1162	my ($self, @widgets) = @_;
1101		1163
1102	$self->SUPER::add (@widgets);	1164	$self->SUPER::add (@widgets);
		1165	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1103	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};	1166	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1104	}	1167	}
1105		1168
1106	sub border {	1169	sub border {
1107	int $_[0]{border} * $::FONTSIZE	1170	int $_[0]{border} * $::FONTSIZE
1108	}	1171	}
1109		1172
1110	sub size_request {	1173	sub size_request {
1111	my ($self) = @_;	1174	my ($self) = @_;
1112		1175
1113	$self->{title}->size_request	1176	$self->{title_widget}->size_request
1114	if $self->{title};	1177	if $self->{title_widget};
		1178
		1179	$self->{close_button}->size_request
		1180	if $self->{close_button};
1115		1181
1116	my ($w, $h) = $self->SUPER::size_request;	1182	my ($w, $h) = $self->SUPER::size_request;
1117		1183
1118	(	1184	(
1119	$w + $self->border * 2,	1185	$w + $self->border * 2,
1120	$h + $self->border * 2,	1186	$h + $self->border * 2,
1121	)	1187	)
1122	}	1188	}
1123		1189
1124	sub size_allocate {	1190	sub invoke_size_allocate {
1125	my ($self, $w, $h) = @_;	1191	my ($self, $w, $h) = @_;
1126		1192
1127	if ($self->{title}) {	1193	if ($self->{title_widget}) {
1128	$self->{title}{w} = $w;	1194	$self->{title_widget}{w} = $w;
1129	$self->{title}{h} = $h;	1195	$self->{title_widget}{h} = $h;
1130	$self->{title}->size_allocate ($w, $h);	1196	$self->{title_widget}->invoke_size_allocate ($w, $h);
1131	}	1197	}
1132		1198
1133	my $border = $self->border;	1199	my $border = $self->border;
1134		1200
1135	$h -= List::Util::max 0, $border * 2;	1201	$h -= List::Util::max 0, $border * 2;
1136	$w -= List::Util::max 0, $border * 2;	1202	$w -= List::Util::max 0, $border * 2;
		1203
		1204	$self->child->configure ($border, $border, $w, $h);
		1205
		1206	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1207	if $self->{close_button};
		1208
		1209	1
		1210	}
		1211
		1212	sub invoke_delete {
		1213	my ($self) = @_;
		1214
		1215	$self->hide;
1137		1216
1138	$self->child->configure ($border, $border, $w, $h);	1217	1
1139	}	1218	}
1140		1219
1141	sub button_down {	1220	sub invoke_button_down {
1142	my ($self, $ev, $x, $y) = @_;	1221	my ($self, $ev, $x, $y) = @_;
1143		1222
1144	my ($w, $h) = @$self{qw(w h)};	1223	my ($w, $h) = @$self{qw(w h)};
1145	my $border = $self->border;	1224	my $border = $self->border;
1146		1225
…		…
1177		1256
1178	($x, $y) = ($ev->{x}, $ev->{y});	1257	($x, $y) = ($ev->{x}, $ev->{y});
1179		1258
1180	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1259	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1181	# HACK: the next line is required to enforce placement	1260	# HACK: the next line is required to enforce placement
1182	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1261	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1183	};	1262	};
1184	} else {	1263	} else {
1185	return 0;	1264	return 0;
1186	}	1265	}
1187		1266
1188	1	1267	1
1189	}	1268	}
1190		1269
1191	sub button_up {	1270	sub invoke_button_up {
1192	my ($self, $ev, $x, $y) = @_;	1271	my ($self, $ev, $x, $y) = @_;
1193		1272
1194	!!delete $self->{motion}	1273	! ! delete $self->{motion}
1195	}	1274	}
1196		1275
1197	sub mouse_motion {	1276	sub invoke_mouse_motion {
1198	my ($self, $ev, $x, $y) = @_;	1277	my ($self, $ev, $x, $y) = @_;
1199		1278
1200	$self->{motion}->($ev, $x, $y) if $self->{motion};	1279	$self->{motion}->($ev, $x, $y) if $self->{motion};
1201		1280
1202	!!$self->{motion}	1281	! ! $self->{motion}
1203	}	1282	}
1204		1283
1205	sub _draw {	1284	sub _draw {
1206	my ($self) = @_;	1285	my ($self) = @_;
1207		1286
…		…
1233		1312
1234	glDisable GL_TEXTURE_2D;	1313	glDisable GL_TEXTURE_2D;
1235		1314
1236	$child->draw;	1315	$child->draw;
1237		1316
1238	if ($self->{title}) {	1317	if ($self->{title_widget}) {
1239	glTranslate 0, $border - $self->{h};	1318	glTranslate 0, $border - $self->{h};
1240	$self->{title}->_draw;	1319	$self->{title_widget}->_draw;
		1320
		1321	glTranslate 0, - ($border - $self->{h});
1241	}	1322	}
		1323
		1324	$self->{close_button}->draw
		1325	if $self->{close_button};
1242	}	1326	}
1243		1327
1244	#############################################################################	1328	#############################################################################
1245		1329
1246	package CFClient::UI::Table;	1330	package CFClient::UI::Table;
…		…
1269		1353
1270	$child->set_parent ($self);	1354	$child->set_parent ($self);
1271	$self->{children}[$y][$x] = $child;	1355	$self->{children}[$y][$x] = $child;
1272		1356
1273	$self->realloc;	1357	$self->realloc;
		1358	}
		1359
		1360	sub remove {
		1361	my ($self, $child) = @_;
		1362
		1363	# TODO: not yet implemented
1274	}	1364	}
1275		1365
1276	# TODO: move to container class maybe? send children a signal on removal?	1366	# TODO: move to container class maybe? send children a signal on removal?
1277	sub clear {	1367	sub clear {
1278	my ($self) = @_;	1368	my ($self) = @_;
…		…
1319	(sum @$ws),	1409	(sum @$ws),
1320	(sum @$hs),	1410	(sum @$hs),
1321	)	1411	)
1322	}	1412	}
1323		1413
1324	sub size_allocate {	1414	sub invoke_size_allocate {
1325	my ($self, $w, $h) = @_;	1415	my ($self, $w, $h) = @_;
1326		1416
1327	my ($ws, $hs) = $self->get_wh;	1417	my ($ws, $hs) = $self->get_wh;
1328		1418
1329	my $req_w = (sum @$ws) || 1;	1419	my $req_w = (sum @$ws) || 1;
…		…
1361	}	1451	}
1362		1452
1363	$y += $row_h;	1453	$y += $row_h;
1364	}	1454	}
1365		1455
		1456	1
1366	}	1457	}
1367		1458
1368	sub find_widget {	1459	sub find_widget {
1369	my ($self, $x, $y) = @_;	1460	my ($self, $x, $y) = @_;
1370		1461
…		…
1407	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1498	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1408	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1499	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1409	)	1500	)
1410	}	1501	}
1411		1502
1412	sub size_allocate {	1503	sub invoke_size_allocate {
1413	my ($self, $w, $h) = @_;	1504	my ($self, $w, $h) = @_;
1414		1505
1415	my $space = $self->{vertical} ? $h : $w;	1506	my $space = $self->{vertical} ? $h : $w;
1416	my $children = $self->{children};	1507	my @children = $self->visible_children;
1417		1508
1418	my @req;	1509	my @req;
1419		1510
1420	if ($self->{homogeneous}) {	1511	if ($self->{homogeneous}) {
1421	@req = ($space / (@$children || 1)) x @$children;	1512	@req = ($space / (@children || 1)) x @children;
1422	} else {	1513	} else {
1423	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1514	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1424	my $req = List::Util::sum @req;	1515	my $req = List::Util::sum @req;
1425		1516
1426	if ($req > $space) {	1517	if ($req > $space) {
1427	# ah well, not enough space	1518	# ah well, not enough space
1428	$_ *= $space / $req for @req;	1519	$_ *= $space / $req for @req;
1429	} else {	1520	} else {
1430	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1521	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1431		1522
1432	$space = ($space - $req) / $expand; # remaining space to give away	1523	$space = ($space - $req) / $expand; # remaining space to give away
1433		1524
1434	$req[$_] += $space * $children->[$_]{expand}	1525	$req[$_] += $space * $children[$_]{expand}
1435	for 0 .. $#$children;	1526	for 0 .. $#children;
1436	}	1527	}
1437	}	1528	}
1438		1529
1439	CFClient::UI::harmonize \@req;	1530	CFClient::UI::harmonize \@req;
1440		1531
1441	my $pos = 0;	1532	my $pos = 0;
1442	for (0 .. $#$children) {	1533	for (0 .. $#children) {
1443	my $alloc = $req[$_];	1534	my $alloc = $req[$_];
1444	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1535	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1445		1536
1446	$pos += $alloc;	1537	$pos += $alloc;
1447	}	1538	}
1448		1539
1449	1	1540	1
…		…
1552	my ($self, $text) = @_;	1643	my ($self, $text) = @_;
1553		1644
1554	return if $self->{text} eq "T$text";	1645	return if $self->{text} eq "T$text";
1555	$self->{text} = "T$text";	1646	$self->{text} = "T$text";
1556		1647
1557	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1558	$self->{layout}->set_text ($text);	1648	$self->{layout}->set_text ($text);
1559		1649
1560	delete $self->{size_req};	1650	delete $self->{size_req};
1561	$self->realloc;	1651	$self->realloc;
1562	$self->update;	1652	$self->update;
…		…
1568	return if $self->{text} eq "M$markup";	1658	return if $self->{text} eq "M$markup";
1569	$self->{text} = "M$markup";	1659	$self->{text} = "M$markup";
1570		1660
1571	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1661	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1572		1662
1573	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1574	$self->{layout}->set_markup ($markup);	1663	$self->{layout}->set_markup ($markup);
1575		1664
1576	delete $self->{size_req};	1665	delete $self->{size_req};
1577	$self->realloc;	1666	$self->realloc;
1578	$self->update;	1667	$self->update;
…		…
1590		1679
1591	my ($w, $h) = $self->{layout}->size;	1680	my ($w, $h) = $self->{layout}->size;
1592		1681
1593	if (exists $self->{template}) {	1682	if (exists $self->{template}) {
1594	$self->{template}->set_font ($self->{font}) if $self->{font};	1683	$self->{template}->set_font ($self->{font}) if $self->{font};
		1684	$self->{template}->set_width ($self->{max_w} || -1);
1595	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1685	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1596		1686
1597	my ($w2, $h2) = $self->{template}->size;	1687	my ($w2, $h2) = $self->{template}->size;
1598		1688
1599	$w = List::Util::max $w, $w2;	1689	$w = List::Util::max $w, $w2;
…		…
1604	};	1694	};
1605		1695
1606	@{ $self->{size_req} }	1696	@{ $self->{size_req} }
1607	}	1697	}
1608		1698
		1699	sub baseline_shift {
		1700	$_[0]{layout}->descent
		1701	}
		1702
1609	sub size_allocate {	1703	sub invoke_size_allocate {
1610	my ($self, $w, $h) = @_;	1704	my ($self, $w, $h) = @_;
1611		1705
1612	delete $self->{ox};	1706	delete $self->{ox};
1613		1707
1614	delete $self->{texture}	1708	delete $self->{texture}
1615	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};	1709	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1710
		1711	1
1616	}	1712	}
1617		1713
1618	sub set_fontsize {	1714	sub set_fontsize {
1619	my ($self, $fontsize) = @_;	1715	my ($self, $fontsize) = @_;
1620		1716
1621	$self->{fontsize} = $fontsize;	1717	$self->{fontsize} = $fontsize;
		1718	delete $self->{size_req};
1622	delete $self->{texture};	1719	delete $self->{texture};
1623		1720
1624	$self->realloc;	1721	$self->realloc;
1625	}	1722	}
1626		1723
1627	sub reconfigure {	1724	sub reconfigure {
1628	my ($self) = @_;	1725	my ($self) = @_;
1629		1726
1630	delete $self->{size_req};	1727	delete $self->{size_req};
		1728	delete $self->{texture};
1631		1729
1632	$self->SUPER::reconfigure;	1730	$self->SUPER::reconfigure;
1633	}	1731	}
1634		1732
1635	sub _draw {	1733	sub _draw {
1636	my ($self) = @_;	1734	my ($self) = @_;
1637		1735
1638	$self->SUPER::_draw; # draw background, if applicable	1736	$self->SUPER::_draw; # draw background, if applicable
1639		1737
1640	my $tex = $self->{texture} ||= do {	1738	my $size = $self->{texture} ||= do {
1641	$self->{layout}->set_foreground (@{$self->{fg}});	1739	$self->{layout}->set_foreground (@{$self->{fg}});
1642	$self->{layout}->set_font ($self->{font}) if $self->{font};	1740	$self->{layout}->set_font ($self->{font}) if $self->{font};
1643	$self->{layout}->set_width ($self->{w});	1741	$self->{layout}->set_width ($self->{w});
1644	$self->{layout}->set_ellipsise ($self->{ellipsise});	1742	$self->{layout}->set_ellipsise ($self->{ellipsise});
1645	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1743	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1646	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1744	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1647		1745
1648	new_from_layout CFClient::Texture $self->{layout}	1746	[$self->{layout}->size]
1649	};	1747	};
1650		1748
1651	unless (exists $self->{ox}) {	1749	unless (exists $self->{ox}) {
1652	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1750	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1653	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1751	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1654	: ($self->{w} - $tex->{w}) * 0.5);	1752	: ($self->{w} - $size->[0]) * 0.5);
1655		1753
1656	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1754	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1657	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1755	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1658	: ($self->{h} - $tex->{h}) * 0.5);	1756	: ($self->{h} - $size->[1]) * 0.5);
1659	};	1757	};
1660		1758
1661	glEnable GL_TEXTURE_2D;
1662
1663	my $w = List::Util::min $self->{w} + 4, $tex->{w};	1759	my $w = List::Util::min $self->{w} + 4, $size->[0];
1664	my $h = List::Util::min $self->{h} + 2, $tex->{h};	1760	my $h = List::Util::min $self->{h} + 2, $size->[1];
1665		1761
1666	if ($tex->{format} == GL_ALPHA) {	1762	$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	}	1763	}
1677		1764
1678	#############################################################################	1765	#############################################################################
1679		1766
1680	package CFClient::UI::EntryBase;	1767	package CFClient::UI::EntryBase;
…		…
1713		1800
1714	$text =~ s/./*/g if $self->{hidden};	1801	$text =~ s/./*/g if $self->{hidden};
1715	$self->{layout}->set_text ("$text ");	1802	$self->{layout}->set_text ("$text ");
1716	delete $self->{size_req};	1803	delete $self->{size_req};
1717		1804
1718	$self->_emit (changed => $self->{text});	1805	$self->emit (changed => $self->{text});
1719		1806
1720	$self->realloc;	1807	$self->realloc;
1721	$self->update;	1808	$self->update;
1722	}	1809	}
1723		1810
…		…
1738	my ($w, $h) = $self->SUPER::size_request;	1825	my ($w, $h) = $self->SUPER::size_request;
1739		1826
1740	($w + 1, $h) # add 1 for cursor	1827	($w + 1, $h) # add 1 for cursor
1741	}	1828	}
1742		1829
1743	sub key_down {	1830	sub invoke_key_down {
1744	my ($self, $ev) = @_;	1831	my ($self, $ev) = @_;
1745		1832
1746	my $mod = $ev->{mod};	1833	my $mod = $ev->{mod};
1747	my $sym = $ev->{sym};	1834	my $sym = $ev->{sym};
1748	my $uni = $ev->{unicode};	1835	my $uni = $ev->{unicode};
…		…
1760	} elsif ($sym == CFClient::SDLK_HOME) {	1847	} elsif ($sym == CFClient::SDLK_HOME) {
1761	$self->{cursor} = 0;	1848	$self->{cursor} = 0;
1762	} elsif ($sym == CFClient::SDLK_END) {	1849	} elsif ($sym == CFClient::SDLK_END) {
1763	$self->{cursor} = length $text;	1850	$self->{cursor} = length $text;
1764	} elsif ($uni == 27) {	1851	} elsif ($uni == 27) {
1765	$self->_emit ('escape');	1852	$self->emit ('escape');
1766	} elsif ($uni) {	1853	} elsif ($uni) {
1767	substr $text, $self->{cursor}++, 0, chr $uni;	1854	substr $text, $self->{cursor}++, 0, chr $uni;
1768	} else {	1855	} else {
1769	return 0;	1856	return 0;
1770	}	1857	}
…		…
1774	$self->realloc;	1861	$self->realloc;
1775		1862
1776	1	1863	1
1777	}	1864	}
1778		1865
1779	sub focus_in {	1866	sub invoke_focus_in {
1780	my ($self) = @_;	1867	my ($self) = @_;
1781		1868
1782	$self->{last_activity} = $::NOW;	1869	$self->{last_activity} = $::NOW;
1783		1870
1784	$self->SUPER::focus_in;	1871	$self->SUPER::invoke_focus_in
1785	}	1872	}
1786		1873
1787	sub button_down {	1874	sub invoke_button_down {
1788	my ($self, $ev, $x, $y) = @_;	1875	my ($self, $ev, $x, $y) = @_;
1789		1876
1790	$self->SUPER::button_down ($ev, $x, $y);	1877	$self->SUPER::invoke_button_down ($ev, $x, $y);
1791		1878
1792	my $idx = $self->{layout}->xy_to_index ($x, $y);	1879	my $idx = $self->{layout}->xy_to_index ($x, $y);
1793		1880
1794	# byte-index to char-index	1881	# byte-index to char-index
1795	my $text = $self->{text};	1882	my $text = $self->{text};
1796	utf8::encode $text;	1883	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1797	$self->{cursor} = length substr $text, 0, $idx;	1884	$self->{cursor} = length $text;
1798		1885
1799	$self->_set_text ($self->{text});	1886	$self->_set_text ($self->{text});
1800	$self->update;	1887	$self->update;
1801		1888
1802	1	1889	1
1803	}	1890	}
1804		1891
1805	sub mouse_motion {	1892	sub invoke_mouse_motion {
1806	my ($self, $ev, $x, $y) = @_;	1893	my ($self, $ev, $x, $y) = @_;
1807	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1894	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1808		1895
1809	0	1896	1
1810	}	1897	}
1811		1898
1812	sub _draw {	1899	sub _draw {
1813	my ($self) = @_;	1900	my ($self) = @_;
1814		1901
…		…
1855		1942
1856	our @ISA = CFClient::UI::EntryBase::;	1943	our @ISA = CFClient::UI::EntryBase::;
1857		1944
1858	use CFClient::OpenGL;	1945	use CFClient::OpenGL;
1859		1946
1860	sub key_down {	1947	sub invoke_key_down {
1861	my ($self, $ev) = @_;	1948	my ($self, $ev) = @_;
1862		1949
1863	my $sym = $ev->{sym};	1950	my $sym = $ev->{sym};
1864		1951
1865	if ($sym == 13) {	1952	if ($sym == 13) {
1866	unshift @{$self->{history}},	1953	unshift @{$self->{history}},
1867	my $txt = $self->get_text;	1954	my $txt = $self->get_text;
		1955
1868	$self->{history_pointer} = -1;	1956	$self->{history_pointer} = -1;
1869	$self->{history_saveback} = '';	1957	$self->{history_saveback} = '';
1870	$self->_emit (activate => $txt);	1958	$self->emit (activate => $txt);
1871	$self->update;	1959	$self->update;
1872		1960
1873	} elsif ($sym == CFClient::SDLK_UP) {	1961	} elsif ($sym == CFClient::SDLK_UP) {
1874	if ($self->{history_pointer} < 0) {	1962	if ($self->{history_pointer} < 0) {
1875	$self->{history_saveback} = $self->get_text;	1963	$self->{history_saveback} = $self->get_text;
…		…
1891	} else {	1979	} else {
1892	$self->set_text ($self->{history_saveback});	1980	$self->set_text ($self->{history_saveback});
1893	}	1981	}
1894		1982
1895	} else {	1983	} else {
1896	return $self->SUPER::key_down ($ev)	1984	return $self->SUPER::invoke_key_down ($ev)
1897	}	1985	}
1898		1986
1899	1	1987	1
1900	}	1988	}
1901		1989
…		…
1925	can_events => 1,	2013	can_events => 1,
1926	@_	2014	@_
1927	)	2015	)
1928	}	2016	}
1929		2017
1930	sub activate { }
1931
1932	sub button_up {	2018	sub invoke_button_up {
1933	my ($self, $ev, $x, $y) = @_;	2019	my ($self, $ev, $x, $y) = @_;
1934		2020
1935	$self->emit ("activate")	2021	$self->emit ("activate")
1936	if $x >= 0 && $x < $self->{w}	2022	if $x >= 0 && $x < $self->{w}
1937	&& $y >= 0 && $y < $self->{h};	2023	&& $y >= 0 && $y < $self->{h};
…		…
1951	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2037	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1952		2038
1953	glDisable GL_TEXTURE_2D;	2039	glDisable GL_TEXTURE_2D;
1954		2040
1955	$self->SUPER::_draw;	2041	$self->SUPER::_draw;
		2042	}
		2043
		2044	#############################################################################
		2045
		2046	package CFClient::UI::ImageButton;
		2047
		2048	our @ISA = CFClient::UI::Image::;
		2049
		2050	use CFClient::OpenGL;
		2051
		2052	my %textures;
		2053
		2054	sub new {
		2055	my $class = shift;
		2056
		2057	my $self = $class->SUPER::new (
		2058	padding_x => 4,
		2059	padding_y => 4,
		2060	fg => [1, 1, 1],
		2061	active_fg => [0, 0, 1],
		2062	can_hover => 1,
		2063	align => 0,
		2064	valign => 0,
		2065	can_events => 1,
		2066	@_
		2067	);
		2068	}
		2069
		2070	sub invoke_button_up {
		2071	my ($self, $ev, $x, $y) = @_;
		2072
		2073	$self->emit ("activate")
		2074	if $x >= 0 && $x < $self->{w}
		2075	&& $y >= 0 && $y < $self->{h};
		2076
		2077	1
1956	}	2078	}
1957		2079
1958	#############################################################################	2080	#############################################################################
1959		2081
1960	package CFClient::UI::CheckBox;	2082	package CFClient::UI::CheckBox;
…		…
1987	my ($self) = @_;	2109	my ($self) = @_;
1988		2110
1989	(6) x 2	2111	(6) x 2
1990	}	2112	}
1991		2113
		2114	sub toggle {
		2115	my ($self) = @_;
		2116
		2117	$self->{state} = !$self->{state};
		2118	$self->emit (changed => $self->{state});
		2119	$self->update;
		2120	}
		2121
1992	sub button_down {	2122	sub invoke_button_down {
1993	my ($self, $ev, $x, $y) = @_;	2123	my ($self, $ev, $x, $y) = @_;
1994		2124
1995	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2125	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1996	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2126	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1997	$self->{state} = !$self->{state};	2127	$self->toggle;
1998	$self->_emit (changed => $self->{state});
1999	} else {	2128	} else {
2000	return 0	2129	return 0
2001	}	2130	}
2002		2131
2003	1	2132	1
…		…
2028	package CFClient::UI::Image;	2157	package CFClient::UI::Image;
2029		2158
2030	our @ISA = CFClient::UI::Base::;	2159	our @ISA = CFClient::UI::Base::;
2031		2160
2032	use CFClient::OpenGL;	2161	use CFClient::OpenGL;
2033	use Carp qw/confess/;
2034		2162
2035	our %loaded_images;	2163	our %texture_cache;
2036		2164
2037	sub new {	2165	sub new {
2038	my $class = shift;	2166	my $class = shift;
2039		2167
2040	my $self = $class->SUPER::new (can_events => 0, @_);	2168	my $self = $class->SUPER::new (
		2169	can_events => 0,
		2170	@_,
		2171	);
2041		2172
2042	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2173	$self->{path} || $self->{tex}
		2174	or Carp::croak "'path' or 'tex' attributes required";
2043		2175
2044	$loaded_images{$self->{image}} ||=	2176	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2045	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2177	new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2046		2178
2047	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2179	Scalar::Util::weaken $texture_cache{$self->{path}};
2048		2180
2049	Scalar::Util::weaken $loaded_images{$self->{image}};	2181	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2050
2051	$self->{aspect} = $tex->{w} / $tex->{h};
2052		2182
2053	$self	2183	$self
2054	}	2184	}
2055		2185
2056	sub size_request {	2186	sub size_request {
2057	my ($self) = @_;	2187	my ($self) = @_;
2058		2188
2059	($self->{tex}->{w}, $self->{tex}->{h})	2189	($self->{tex}{w}, $self->{tex}{h})
2060	}	2190	}
2061		2191
2062	sub _draw {	2192	sub _draw {
2063	my ($self) = @_;	2193	my ($self) = @_;
2064		2194
…		…
2173	my $ycut1 = max 0, min 1, $ycut;	2303	my $ycut1 = max 0, min 1, $ycut;
2174	my $ycut2 = max 0, min 1, $ycut - 1;	2304	my $ycut2 = max 0, min 1, $ycut - 1;
2175		2305
2176	my $h1 = $self->{h} * (1 - $ycut1);	2306	my $h1 = $self->{h} * (1 - $ycut1);
2177	my $h2 = $self->{h} * (1 - $ycut2);	2307	my $h2 = $self->{h} * (1 - $ycut2);
		2308	my $h3 = $self->{h};
		2309
		2310	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2178		2311
2179	glEnable GL_BLEND;	2312	glEnable GL_BLEND;
2180	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2313	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2181	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2314	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2182	glEnable GL_TEXTURE_2D;	2315	glEnable GL_TEXTURE_2D;
…		…
2201		2334
2202	if ($t3) {	2335	if ($t3) {
2203	glBindTexture GL_TEXTURE_2D, $t3->{name};	2336	glBindTexture GL_TEXTURE_2D, $t3->{name};
2204	glBegin GL_QUADS;	2337	glBegin GL_QUADS;
2205	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2338	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2206	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2339	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2207	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2340	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2208	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2341	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2209	glEnd;	2342	glEnd;
2210	}	2343	}
2211		2344
2212	glDisable GL_BLEND;	2345	glDisable GL_BLEND;
…		…
2300	$self->update;	2433	$self->update;
2301		2434
2302	$self	2435	$self
2303	}	2436	}
2304		2437
2305	sub changed { }
2306
2307	sub set_range {	2438	sub set_range {
2308	my ($self, $range) = @_;	2439	my ($self, $range) = @_;
2309		2440
2310	($range, $self->{range}) = ($self->{range}, $range);	2441	($range, $self->{range}) = ($self->{range}, $range);
2311		2442
…		…
2331	if $unit;	2462	if $unit;
2332		2463
2333	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2464	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2334		2465
2335	if ($value != $old_value) {	2466	if ($value != $old_value) {
2336	$self->_emit (changed => $value);	2467	$self->emit (changed => $value);
2337	$self->update;	2468	$self->update;
2338	}	2469	}
2339	}	2470	}
2340		2471
2341	sub size_request {	2472	sub size_request {
2342	my ($self) = @_;	2473	my ($self) = @_;
2343		2474
2344	($self->{req_w}, $self->{req_h})	2475	($self->{req_w}, $self->{req_h})
2345	}	2476	}
2346		2477
2347	sub button_down {	2478	sub invoke_button_down {
2348	my ($self, $ev, $x, $y) = @_;	2479	my ($self, $ev, $x, $y) = @_;
2349		2480
2350	$self->SUPER::button_down ($ev, $x, $y);	2481	$self->SUPER::invoke_button_down ($ev, $x, $y);
2351		2482
2352	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2483	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2353		2484
2354	$self->mouse_motion ($ev, $x, $y)	2485	$self->invoke_mouse_motion ($ev, $x, $y)
2355	}	2486	}
2356		2487
2357	sub mouse_motion {	2488	sub invoke_mouse_motion {
2358	my ($self, $ev, $x, $y) = @_;	2489	my ($self, $ev, $x, $y) = @_;
2359		2490
2360	if ($GRAB == $self) {	2491	if ($GRAB == $self) {
2361	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2492	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2362		2493
…		…
2368	} else {	2499	} else {
2369	return 0;	2500	return 0;
2370	}	2501	}
2371		2502
2372	1	2503	1
		2504	}
		2505
		2506	sub invoke_mouse_wheel {
		2507	my ($self, $ev) = @_;
		2508
		2509	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2510
		2511	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.1);
		2512
		2513	! ! $delta
2373	}	2514	}
2374		2515
2375	sub update {	2516	sub update {
2376	my ($self) = @_;	2517	my ($self) = @_;
2377		2518
…		…
2478	sub new {	2619	sub new {
2479	my $class = shift;	2620	my $class = shift;
2480		2621
2481	my $self = $class->SUPER::new (	2622	my $self = $class->SUPER::new (
2482	fontsize => 1,	2623	fontsize => 1,
2483	can_events => 0,	2624	can_events => 1,
2484	indent => 0,	2625	indent => 0,
2485	#font => default_font	2626	#font => default_font
2486	@_,	2627	@_,
2487		2628
2488	layout => (new CFClient::Layout 1),	2629	layout => (new CFClient::Layout),
2489	par => [],	2630	par => [],
2490	height => 0,	2631	height => 0,
2491	children => [	2632	children => [
2492	(new CFClient::UI::Empty expand => 1),	2633	(new CFClient::UI::Empty expand => 1),
2493	(new CFClient::UI::Slider vertical => 1),	2634	(new CFClient::UI::Slider vertical => 1),
…		…
2504		2645
2505	$self->{fontsize} = $fontsize;	2646	$self->{fontsize} = $fontsize;
2506	$self->reflow;	2647	$self->reflow;
2507	}	2648	}
2508		2649
		2650	sub size_request {
		2651	my ($self) = @_;
		2652
		2653	my ($empty, $slider) = @{ $self->{children} };
		2654
		2655	local $self->{children} = [$empty, $slider];
		2656	$self->SUPER::size_request
		2657	}
		2658
2509	sub size_allocate {	2659	sub invoke_size_allocate {
2510	my ($self, $w, $h) = @_;	2660	my ($self, $w, $h) = @_;
2511		2661
2512	$self->SUPER::size_allocate ($w, $h);	2662	my ($empty, $slider, @other) = @{ $self->{children} };
		2663	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2513		2664
2514	$self->{layout}->set_font ($self->{font}) if $self->{font};	2665	$self->{layout}->set_font ($self->{font}) if $self->{font};
2515	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2666	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2516	$self->{layout}->set_width ($self->{children}[0]{w});	2667	$self->{layout}->set_width ($empty->{w});
2517	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2668	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2518		2669
2519	$self->reflow;	2670	$self->reflow;
2520	}
2521		2671
2522	sub text_size {	2672	local $self->{children} = [$empty, $slider];
		2673	$self->SUPER::invoke_size_allocate ($w, $h)
		2674	}
		2675
		2676	sub invoke_mouse_wheel {
2523	my ($self, $text, $indent) = @_;	2677	my ($self, $ev) = @_;
		2678
		2679	return 0 unless $ev->{dy}; # only vertical movements
		2680
		2681	$self->{children}[1]->emit (mouse_wheel => $ev);
		2682
		2683	1
		2684	}
		2685
		2686	sub get_layout {
		2687	my ($self, $para) = @_;
2524		2688
2525	my $layout = $self->{layout};	2689	my $layout = $self->{layout};
2526		2690
		2691	$layout->set_font ($self->{font}) if $self->{font};
		2692	$layout->set_foreground (@{$para->{fg}});
2527	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2693	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2528	$layout->set_width ($self->{children}[0]{w} - $indent);	2694	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2529	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2695	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2530	$layout->set_markup ($text);	2696	$layout->set_markup ($para->{markup});
		2697
		2698	$layout->set_shapes (
		2699	map
		2700	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		2701	@{$para->{widget}}
2531		2702	);
		2703
2532	$layout->size	2704	$layout
2533	}	2705	}
2534		2706
2535	sub reflow {	2707	sub reflow {
2536	my ($self) = @_;	2708	my ($self) = @_;
2537		2709
…		…
2546	$self->{children}[1]->set_value ($offset);	2718	$self->{children}[1]->set_value ($offset);
2547	}	2719	}
2548		2720
2549	sub clear {	2721	sub clear {
2550	my ($self) = @_;	2722	my ($self) = @_;
		2723
		2724	my (undef, undef, @other) = @{ $self->{children} };
		2725	$self->remove ($_) for @other;
2551		2726
2552	$self->{par} = [];	2727	$self->{par} = [];
2553	$self->{height} = 0;	2728	$self->{height} = 0;
2554	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2729	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2555	}	2730	}
2556		2731
2557	sub add_paragraph {	2732	sub add_paragraph {
2558	my ($self, $color, $text, $indent) = @_;	2733	my ($self, $color, $para, $indent) = @_;
2559		2734
2560	for my $line (split /\n/, $text) {	2735	my ($text, @w) = ref $para ? @$para : $para;
2561	my ($w, $h) = $self->text_size ($line);	2736
2562	$self->{height} += $h;	2737	$para = {
2563	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	2738	w => 1e10,
		2739	wrapped => 1,
		2740	fg => $color,
		2741	indent => $indent,
		2742	markup => $text,
		2743	widget => \@w,
2564	}	2744	};
2565		2745
2566	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	2746	$self->add (@w) if @w;
		2747	push @{$self->{par}}, $para;
		2748
		2749	$self->{need_reflow}++;
		2750	$self->update;
		2751	}
		2752
		2753	sub scroll_to_bottom {
		2754	my ($self) = @_;
		2755
		2756	$self->{scroll_to_bottom} = 1;
		2757	$self->update;
2567	}	2758	}
2568		2759
2569	sub update {	2760	sub update {
2570	my ($self) = @_;	2761	my ($self) = @_;
2571		2762
…		…
2579	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2770	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2580		2771
2581	if (delete $self->{need_reflow}) {	2772	if (delete $self->{need_reflow}) {
2582	my $height = 0;	2773	my $height = 0;
2583		2774
2584	my $layout = $self->{layout};
2585
2586	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2587
2588	for (@{$self->{par}}) {	2775	for my $para (@{$self->{par}}) {
2589	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2776	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2590	$layout->set_width ($W - $_->[3]);	2777	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;	2778	my ($w, $h) = $layout->size;
2594	$_->[0] = $w + $_->[3];	2779
2595	$_->[1] = $h;	2780	$para->{w} = $w + $para->{indent};
		2781	$para->{h} = $h;
		2782	$para->{wrapped} = $layout->has_wrapped;
2596	}	2783	}
2597		2784
2598	$height += $_->[1];	2785	$height += $para->{h};
2599	}	2786	}
2600		2787
2601	$self->{height} = $height;	2788	$self->{height} = $height;
2602		2789
2603	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2790	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2604		2791
2605	delete $self->{texture};	2792	delete $self->{texture};
		2793	}
		2794
		2795	if (delete $self->{scroll_to_bottom}) {
		2796	$self->{children}[1]->set_value (1e10);
2606	}	2797	}
2607		2798
2608	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2799	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2609	glClearColor 0, 0, 0, 0;	2800	glClearColor 0, 0, 0, 0;
2610	glClear GL_COLOR_BUFFER_BIT;	2801	glClear GL_COLOR_BUFFER_BIT;
…		…
2614	my $y0 = $top;	2805	my $y0 = $top;
2615	my $y1 = $top + $H;	2806	my $y1 = $top + $H;
2616		2807
2617	my $y = 0;	2808	my $y = 0;
2618		2809
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}}) {	2810	for my $para (@{$self->{par}}) {
2628	my $h = $par->[1];	2811	my $h = $para->{h};
2629		2812
2630	if ($y0 < $y + $h && $y < $y1) {	2813	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		2814
2636	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2815	my $layout = $self->get_layout ($para);
2637		2816
2638	glRasterPos $par->[3], $y - $y0;	2817	$layout->render ($para->{indent}, $y - $y0);
2639	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	2818
		2819	if (my @w = @{ $para->{widget} }) {
		2820	my @s = $layout->get_shapes;
		2821
		2822	for (@w) {
		2823	my ($dx, $dy) = splice @s, 0, 2, ();
		2824
		2825	$_->{x} = $dx + $para->{indent};
		2826	$_->{y} = $dy + $y - $y0;
		2827
		2828	$_->draw;
		2829	}
		2830	}
2640	}	2831	}
2641		2832
2642	$y += $h;	2833	$y += $h;
2643	}	2834	}
2644
2645	glDisable GL_BLEND;
2646	};	2835	};
2647	});	2836	});
		2837	}
		2838
		2839	sub reconfigure {
		2840	my ($self) = @_;
		2841
		2842	$self->SUPER::reconfigure;
		2843
		2844	$_->{w} = 1e10 for @{ $self->{par} };
		2845	$self->reflow;
2648	}	2846	}
2649		2847
2650	sub _draw {	2848	sub _draw {
2651	my ($self) = @_;	2849	my ($self) = @_;
2652		2850
…		…
2655	glColor 0, 0, 0, 1;	2853	glColor 0, 0, 0, 1;
2656	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2854	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2657	glDisable GL_TEXTURE_2D;	2855	glDisable GL_TEXTURE_2D;
2658		2856
2659	$self->{children}[1]->draw;	2857	$self->{children}[1]->draw;
2660
2661	}	2858	}
2662		2859
2663	#############################################################################	2860	#############################################################################
2664		2861
2665	package CFClient::UI::Animator;	2862	package CFClient::UI::Animator;
…		…
2774	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2971	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2775		2972
2776	($w + 4, $h + 4)	2973	($w + 4, $h + 4)
2777	}	2974	}
2778		2975
2779	sub size_allocate {	2976	sub invoke_size_allocate {
2780	my ($self, $w, $h) = @_;	2977	my ($self, $w, $h) = @_;
2781		2978
2782	$self->SUPER::size_allocate ($w - 4, $h - 4);	2979	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2783	}	2980	}
2784		2981
2785	sub visibility_change {	2982	sub invoke_visibility_change {
2786	my ($self, $visible) = @_;	2983	my ($self, $visible) = @_;
2787		2984
2788	return unless $visible;	2985	return unless $visible;
2789		2986
2790	$self->{root}->on_post_alloc ("move_$self" => sub {	2987	$self->{root}->on_post_alloc ("move_$self" => sub {
…		…
2897	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3094	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2898	glDisable GL_TEXTURE_2D;	3095	glDisable GL_TEXTURE_2D;
2899	}	3096	}
2900	}	3097	}
2901		3098
2902	sub DESTROY {	3099	sub destroy {
2903	my ($self) = @_;	3100	my ($self) = @_;
2904		3101
2905	$self->{timer}->cancel	3102	$self->{timer}->cancel
2906	if $self->{timer};	3103	if $self->{timer};
2907		3104
2908	$self->SUPER::DESTROY;	3105	$self->SUPER::destroy;
2909	}	3106	}
2910		3107
2911	#############################################################################	3108	#############################################################################
2912		3109
2913	package CFClient::UI::Buttonbar;	3110	package CFClient::UI::Buttonbar;
…		…
2938	for my $item (@{ $self->{items} }) {	3135	for my $item (@{ $self->{items} }) {
2939	my ($widget, $cb, $tooltip) = @$item;	3136	my ($widget, $cb, $tooltip) = @$item;
2940		3137
2941	# handle various types of items, only text for now	3138	# handle various types of items, only text for now
2942	if (!ref $widget) {	3139	if (!ref $widget) {
		3140	if ($widget =~ /\t/) {
		3141	my ($left, $right) = split /\t/, $widget, 2;
		3142
		3143	$widget = new CFClient::UI::HBox
		3144	can_hover => 1,
		3145	can_events => 1,
		3146	tooltip => $tooltip,
		3147	children => [
		3148	(new CFClient::UI::Label markup => $left, expand => 1),
		3149	(new CFClient::UI::Label markup => $right, align => +1),
		3150	],
		3151	;
		3152
		3153	} else {
2943	$widget = new CFClient::UI::Label	3154	$widget = new CFClient::UI::Label
2944	can_hover => 1,	3155	can_hover => 1,
2945	can_events => 1,	3156	can_events => 1,
2946	markup => $widget,	3157	markup => $widget,
2947	tooltip => $tooltip	3158	tooltip => $tooltip;
		3159	}
2948	}	3160	}
2949		3161
2950	$self->{item}{$widget} = $item;	3162	$self->{item}{$widget} = $item;
2951		3163
2952	$self->{vbox}->add ($widget);	3164	$self->{vbox}->add ($widget);
…		…
2957		3169
2958	# popup given the event (must be a mouse button down event currently)	3170	# popup given the event (must be a mouse button down event currently)
2959	sub popup {	3171	sub popup {
2960	my ($self, $ev) = @_;	3172	my ($self, $ev) = @_;
2961		3173
2962	$self->_emit ("popdown");	3174	$self->emit ("popdown");
2963		3175
2964	# maybe save $GRAB? must be careful about events...	3176	# maybe save $GRAB? must be careful about events...
2965	$GRAB = $self;	3177	$GRAB = $self;
2966	$self->{button} = $ev->{button};	3178	$self->{button} = $ev->{button};
2967		3179
2968	$self->show;	3180	$self->show;
2969	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3181	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2970	}	3182	}
2971		3183
2972	sub mouse_motion {	3184	sub invoke_mouse_motion {
2973	my ($self, $ev, $x, $y) = @_;	3185	my ($self, $ev, $x, $y) = @_;
2974		3186
2975	# TODO: should use vbox->find_widget or so	3187	# TODO: should use vbox->find_widget or so
2976	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3188	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2977	$self->{hover} = $self->{item}{$HOVER};	3189	$self->{hover} = $self->{item}{$HOVER};
2978		3190
2979	0	3191	0
2980	}	3192	}
2981		3193
2982	sub button_up {	3194	sub invoke_button_up {
2983	my ($self, $ev, $x, $y) = @_;	3195	my ($self, $ev, $x, $y) = @_;
2984		3196
2985	if ($ev->{button} == $self->{button}) {	3197	if ($ev->{button} == $self->{button}) {
2986	undef $GRAB;	3198	undef $GRAB;
2987	$self->hide;	3199	$self->hide;
2988		3200
2989	$self->_emit ("popdown");	3201	$self->emit ("popdown");
2990	$self->{hover}[1]->() if $self->{hover};	3202	$self->{hover}[1]->() if $self->{hover};
2991	} else {	3203	} else {
2992	return 0	3204	return 0
2993	}	3205	}
2994		3206
…		…
3021		3233
3022	$self->{current} = $self->{children}[0]	3234	$self->{current} = $self->{children}[0]
3023	if @{ $self->{children} };	3235	if @{ $self->{children} };
3024	}	3236	}
3025		3237
		3238	sub get_current_page {
		3239	my ($self) = @_;
		3240
		3241	$self->{current}
		3242	}
		3243
3026	sub set_current_page {	3244	sub set_current_page {
3027	my ($self, $page_or_widget) = @_;	3245	my ($self, $page_or_widget) = @_;
3028		3246
3029	my $widget = ref $page_or_widget	3247	my $widget = ref $page_or_widget
3030	? $page_or_widget	3248	? $page_or_widget
3031	: $self->{children}[$page_or_widget];	3249	: $self->{children}[$page_or_widget];
3032		3250
3033	$self->{current} = $widget;	3251	$self->{current} = $widget;
3034	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3252	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3035		3253
3036	$self->_emit (page_changed => $self->{current});	3254	$self->emit (page_changed => $self->{current});
3037		3255
3038	$self->realloc;	3256	$self->realloc;
3039	}	3257	}
3040		3258
3041	sub visible_children {	3259	sub visible_children {
…		…
3046	my ($self) = @_;	3264	my ($self) = @_;
3047		3265
3048	$self->{current}->size_request	3266	$self->{current}->size_request
3049	}	3267	}
3050		3268
3051	sub size_allocate {	3269	sub invoke_size_allocate {
3052	my ($self, $w, $h) = @_;	3270	my ($self, $w, $h) = @_;
3053		3271
3054	$self->{current}->configure (0, 0, $w, $h);	3272	$self->{current}->configure (0, 0, $w, $h);
		3273
		3274	1
3055	}	3275	}
3056		3276
3057	sub _draw {	3277	sub _draw {
3058	my ($self) = @_;	3278	my ($self) = @_;
3059		3279
…		…
3094	);	3314	);
3095		3315
3096	$self->{multiplexer}->add ($widget);	3316	$self->{multiplexer}->add ($widget);
3097	}	3317	}
3098		3318
		3319	sub get_current_page {
		3320	my ($self) = @_;
		3321
		3322	$self->{multiplexer}->get_current_page
		3323	}
		3324
3099	sub set_current_page {	3325	sub set_current_page {
3100	my ($self, $page) = @_;	3326	my ($self, $page) = @_;
3101		3327
3102	$self->{multiplexer}->set_current_page ($page);	3328	$self->{multiplexer}->set_current_page ($page);
3103	$self->_emit (page_changed => $self->{multiplexer}{current});	3329	$self->emit (page_changed => $self->{multiplexer}{current});
3104	}	3330	}
3105		3331
3106	#############################################################################	3332	#############################################################################
3107		3333
3108	package CFClient::UI::Combobox;	3334	package CFClient::UI::Combobox;
…		…
3123	$self->_set_value ($self->{value});	3349	$self->_set_value ($self->{value});
3124		3350
3125	$self	3351	$self
3126	}	3352	}
3127		3353
3128	sub button_down {	3354	sub invoke_button_down {
3129	my ($self, $ev) = @_;	3355	my ($self, $ev) = @_;
3130		3356
3131	my @menu_items;	3357	my @menu_items;
3132		3358
3133	for (@{ $self->{options} }) {	3359	for (@{ $self->{options} }) {
…		…
3154	my ($self, $value) = @_;	3380	my ($self, $value) = @_;
3155		3381
3156	return unless $self->{value} ne $value;	3382	return unless $self->{value} ne $value;
3157		3383
3158	$self->_set_value ($value);	3384	$self->_set_value ($value);
3159	$self->_emit (changed => $value);	3385	$self->emit (changed => $value);
3160	}	3386	}
3161		3387
3162	#############################################################################	3388	#############################################################################
3163		3389
3164	package CFClient::UI::Statusbox;	3390	package CFClient::UI::Statusbox;
…		…
3279	count => 1,	3505	count => 1,
3280	%arg,	3506	%arg,
3281	};	3507	};
3282	}	3508	}
3283		3509
		3510	$ROOT->on_refresh (reorder => sub {
3284	$self->reorder;	3511	$self->reorder;
		3512	});
3285	}	3513	}
3286		3514
3287	sub reconfigure {	3515	sub reconfigure {
3288	my ($self) = @_;	3516	my ($self) = @_;
3289		3517
…		…
3292		3520
3293	$self->reorder;	3521	$self->reorder;
3294	$self->SUPER::reconfigure;	3522	$self->SUPER::reconfigure;
3295	}	3523	}
3296		3524
3297	sub DESTROY {	3525	sub destroy {
3298	my ($self) = @_;	3526	my ($self) = @_;
3299		3527
3300	$self->{timer}->cancel;	3528	$self->{timer}->cancel;
3301		3529
3302	$self->SUPER::DESTROY;	3530	$self->SUPER::destroy;
3303	}	3531	}
3304		3532
3305	#############################################################################	3533	#############################################################################
3306		3534
3307	package CFClient::UI::Inventory;	3535	package CFClient::UI::Inventory;
3308		3536
3309	our @ISA = CFClient::UI::ScrolledWindow::;	3537	our @ISA = CFClient::UI::Table::;
3310		3538
3311	sub new {	3539	sub new {
3312	my $class = shift;	3540	my $class = shift;
3313		3541
3314	my $self = $class->SUPER::new (	3542	my $self = $class->SUPER::new (
3315	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),	3543	col_expand => [0, 1, 0],
3316	@_,	3544	@_,
3317	);	3545	);
3318		3546
3319	$self	3547	$self
3320	}	3548	}
3321		3549
3322	sub set_items {	3550	sub set_items {
3323	my ($self, $items) = @_;	3551	my ($self, $items) = @_;
3324		3552
3325	$self->{child}->clear;	3553	$self->clear;
3326	return unless $items;	3554	return unless $items;
3327		3555
3328	my @items = sort {	3556	my @items = sort {
3329	($a->{type} <=> $b->{type})	3557	($a->{type} <=> $b->{type})
3330	or ($a->{name} cmp $b->{name})	3558	or ($a->{name} cmp $b->{name})
3331	} @$items;	3559	} values %$items;
3332		3560
3333	$self->{real_items} = \@items;	3561	$self->{real_items} = \@items;
3334		3562
3335	my $row = 0;	3563	my $row = 0;
3336	for my $item (@items) {	3564	for my $item (@items) {
3337	CFClient::Item::update_widgets $item;	3565	CFClient::Item::update_widgets $item;
3338		3566
3339	$self->{child}->add (0, $row, $item->{face_widget});	3567	$self->add (0, $row, $item->{face_widget});
3340	$self->{child}->add (1, $row, $item->{desc_widget});	3568	$self->add (1, $row, $item->{desc_widget});
3341	$self->{child}->add (2, $row, $item->{weight_widget});	3569	$self->add (2, $row, $item->{weight_widget});
3342		3570
3343	$row++;	3571	$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	}	3572	}
3542	}	3573	}
3543		3574
3544	#############################################################################	3575	#############################################################################
3545		3576
…		…
3574	my ($self) = @_;	3605	my ($self) = @_;
3575		3606
3576	$CFClient::UI::ROOT->on_refresh ($self => sub {	3607	$CFClient::UI::ROOT->on_refresh ($self => sub {
3577	$self->clear;	3608	$self->clear;
3578		3609
		3610	return unless $::CONN;
		3611
3579	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);	3612	$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);	3613	$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);	3614	$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);	3615	$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);	3616	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
…		…
3597	} elsif ($ev->{button} == 2) {	3630	} elsif ($ev->{button} == 2) {
3598	$::CONN->user_send ("invoke $spell->{name}");	3631	$::CONN->user_send ("invoke $spell->{name}");
3599	} elsif ($ev->{button} == 3) {	3632	} elsif ($ev->{button} == 3) {
3600	(new CFClient::UI::Menu	3633	(new CFClient::UI::Menu
3601	items => [	3634	items => [
3602	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],	3635	["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}"]) }],	3636	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3604	],	3637	],
3605	)->popup ($ev);	3638	)->popup ($ev);
3606	} else {	3639	} else {
3607	return 0;	3640	return 0;
…		…
3702	$coord = $max - $size if $coord > $max - $size;	3735	$coord = $max - $size if $coord > $max - $size;
3703		3736
3704	int $coord + 0.5	3737	int $coord + 0.5
3705	}	3738	}
3706		3739
3707	sub size_allocate {	3740	sub invoke_size_allocate {
3708	my ($self, $w, $h) = @_;	3741	my ($self, $w, $h) = @_;
3709		3742
3710	for my $child ($self->children) {	3743	for my $child ($self->children) {
3711	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3744	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3712		3745
…		…
3716	$X = _to_pixel $X, $W, $self->{w};	3749	$X = _to_pixel $X, $W, $self->{w};
3717	$Y = _to_pixel $Y, $H, $self->{h};	3750	$Y = _to_pixel $Y, $H, $self->{h};
3718		3751
3719	$child->configure ($X, $Y, $W, $H);	3752	$child->configure ($X, $Y, $W, $H);
3720	}	3753	}
		3754
		3755	1
3721	}	3756	}
3722		3757
3723	sub coord2local {	3758	sub coord2local {
3724	my ($self, $x, $y) = @_;	3759	my ($self, $x, $y) = @_;
3725		3760
…		…
3851	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3886	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3852		3887
3853	$w = 0 if $w < 0;	3888	$w = 0 if $w < 0;
3854	$h = 0 if $h < 0;	3889	$h = 0 if $h < 0;
3855		3890
		3891	$w = max $widget->{min_w}, $w;
		3892	$h = max $widget->{min_h}, $h;
		3893
		3894	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3895	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3896
3856	$w = int $w + 0.5;	3897	$w = int $w + 0.5;
3857	$h = int $h + 0.5;	3898	$h = int $h + 0.5;
3858		3899
3859	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	3900	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3860	$widget->{old_w} = $widget->{w};	3901	$widget->{old_w} = $widget->{w};

Diff Legend

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