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.302 by root, Mon Jun 12 13:26:14 2006 UTC vs.
Revision 1.330 by root, Sun Jul 23 04:37:51 2006 UTC

…		…
79	sub feed_sdl_key_up_event {	79	sub feed_sdl_key_up_event {
80	$FOCUS->emit (key_up => $_[0])	80	$FOCUS->emit (key_up => $_[0])
81	if $FOCUS;	81	if $FOCUS;
82	}	82	}
83		83
		84	sub check_hover {
		85	my ($widget) = @_;
		86
		87	if ($widget != $HOVER) {
		88	my $hover = $HOVER; $HOVER = $widget;
		89
		90	$hover->update if $hover && $hover->{can_hover};
		91	$HOVER->update if $HOVER && $HOVER->{can_hover};
		92
		93	$TOOLTIP_WATCHER->start;
		94	}
		95	}
		96
84	sub feed_sdl_button_down_event {	97	sub feed_sdl_button_down_event {
85	my ($ev) = @_;	98	my ($ev) = @_;
86	my ($x, $y) = ($ev->{x}, $ev->{y});	99	my ($x, $y) = ($ev->{x}, $ev->{y});
87		100
88	if (!$BUTTON_STATE) {	101	unless ($BUTTON_STATE) {
89	my $widget = $ROOT->find_widget ($x, $y);	102	my $widget = $ROOT->find_widget ($x, $y);
90		103
91	$GRAB = $widget;	104	$GRAB = $widget;
92	$GRAB->update if $GRAB;	105	$GRAB->update if $GRAB;
93		106
94	$TOOLTIP_WATCHER->cb->();	107	$TOOLTIP_WATCHER->cb->();
95	}	108	}
96		109
97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	110	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
98		111
99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	112	if ($GRAB) {
100	if $GRAB;	113	if ($ev->{button} == 4 || $ev->{button} == 5) {
		114	# mousewheel
		115	$ev->{dx} = 0;
		116	$ev->{dy} = $ev->{button} * 2 - 9;
		117	$GRAB->emit (mouse_wheel => $ev);
		118	} else {
		119	$GRAB->emit (button_down => $ev)
		120	}
		121	}
101	}	122	}
102		123
103	sub feed_sdl_button_up_event {	124	sub feed_sdl_button_up_event {
104	my ($ev) = @_;	125	my ($ev) = @_;
105	my ($x, $y) = ($ev->{x}, $ev->{y});
106		126
107	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	127	my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
108		128
109	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	129	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
110		130
111	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))	131	$GRAB->emit (button_up => $ev)
112	if $GRAB;	132	if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
113		133
114	if (!$BUTTON_STATE) {	134	unless ($BUTTON_STATE) {
115	my $grab = $GRAB; undef $GRAB;	135	my $grab = $GRAB; undef $GRAB;
116	$grab->update if $grab;	136	$grab->update if $grab;
117	$GRAB->update if $GRAB;	137	$GRAB->update if $GRAB;
118		138
		139	check_hover $widget;
119	$TOOLTIP_WATCHER->cb->();	140	$TOOLTIP_WATCHER->cb->();
120	}	141	}
121	}	142	}
122		143
123	sub feed_sdl_motion_event {	144	sub feed_sdl_motion_event {
124	my ($ev) = @_;	145	my ($ev) = @_;
125	my ($x, $y) = ($ev->{x}, $ev->{y});	146	my ($x, $y) = ($ev->{x}, $ev->{y});
126		147
127	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	148	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
128		149
129	if ($widget != $HOVER) {	150	check_hover $widget;
130	my $hover = $HOVER; $HOVER = $widget;
131		151
132	$hover->update if $hover && $hover->{can_hover};	152	$HOVER->emit (mouse_motion => $ev)
133	$HOVER->update if $HOVER && $HOVER->{can_hover};
134
135	$TOOLTIP_WATCHER->start;
136	}
137
138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
139	if $HOVER;	153	if $HOVER;
140	}	154	}
141		155
142	# convert position array to integers	156	# convert position array to integers
143	sub harmonize {	157	sub harmonize {
…		…
189		203
190	}	204	}
191	}	205	}
192		206
193	reconfigure_widgets;	207	reconfigure_widgets;
		208	}
		209
		210	#############################################################################
		211
		212	package CFClient::UI::Event;
		213
		214	sub xy {
		215	$_[1]->coord2local ($_[0]{x}, $_[0]{y})
194	}	216	}
195		217
196	#############################################################################	218	#############################################################################
197		219
198	package CFClient::UI::Base;	220	package CFClient::UI::Base;
…		…
281	undef $HOVER if $HOVER == $self;	303	undef $HOVER if $HOVER == $self;
282		304
283	$CFClient::UI::TOOLTIP_WATCHER->cb->()	305	$CFClient::UI::TOOLTIP_WATCHER->cb->()
284	if $TOOLTIP->{owner} == $self;	306	if $TOOLTIP->{owner} == $self;
285		307
286	$self->focus_out;	308	$self->emit ("focus_out");
287
288	$self->emit (visibility_change => 0);	309	$self->emit (visibility_change => 0);
289	}	310	}
290		311
291	sub set_visibility {	312	sub set_visibility {
292	my ($self, $visible) = @_;	313	my ($self, $visible) = @_;
…		…
334	}	355	}
335		356
336	sub size_request {	357	sub size_request {
337	require Carp;	358	require Carp;
338	Carp::confess "size_request is abstract";	359	Carp::confess "size_request is abstract";
		360	}
		361
		362	sub baseline_shift {
		363	0
339	}	364	}
340		365
341	sub configure {	366	sub configure {
342	my ($self, $x, $y, $w, $h) = @_;	367	my ($self, $x, $y, $w, $h) = @_;
343		368
…		…
367		392
368	$self->{root}{size_alloc}{$self+0} = $self;	393	$self->{root}{size_alloc}{$self+0} = $self;
369	}	394	}
370	}	395	}
371		396
372	sub size_allocate {
373	# nothing to be done
374	}
375
376	sub children {	397	sub children {
377	# nop	398	# nop
378	}	399	}
379		400
380	sub visible_children {	401	sub visible_children {
…		…
418	my ($self, $x, $y) = @_;	439	my ($self, $x, $y) = @_;
419		440
420	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	441	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421	}	442	}
422		443
423	sub focus_in {	444	sub invoke_focus_in {
424	my ($self) = @_;	445	my ($self) = @_;
425		446
426	return if $FOCUS == $self;	447	return if $FOCUS == $self;
427	return unless $self->{can_focus};	448	return unless $self->{can_focus};
428		449
429	my $focus = $FOCUS; $FOCUS = $self;	450	$FOCUS = $self;
430		451
431	$self->_emit (focus_in => $focus);	452	$self->update;
432		453
433	$focus->update if $focus;	454	0
434	$FOCUS->update;
435	}	455	}
436		456
437	sub focus_out {	457	sub invoke_focus_out {
438	my ($self) = @_;	458	my ($self) = @_;
439		459
440	return unless $FOCUS == $self;	460	return unless $FOCUS == $self;
441		461
442	my $focus = $FOCUS; undef $FOCUS;	462	undef $FOCUS;
443		463
444	$self->_emit (focus_out => $focus);	464	$self->update;
445		465
446	$focus->update if $focus; #?
447
448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	466	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449	unless $FOCUS;	467	unless $FOCUS;
450	}
451		468
		469	0
		470	}
		471
		472	sub grab_focus {
		473	my ($self) = @_;
		474
		475	$FOCUS->emit ("focus_out") if $FOCUS;
		476	$self->emit ("focus_in");
		477	}
		478
452	sub mouse_motion { 0 }	479	sub invoke_mouse_motion { 0 }
453	sub button_up { 0 }	480	sub invoke_button_up { 0 }
454	sub key_down { 0 }	481	sub invoke_key_down { 0 }
455	sub key_up { 0 }	482	sub invoke_key_up { 0 }
		483	sub invoke_mouse_wheel { 0 }
456		484
457	sub button_down {	485	sub invoke_button_down {
458	my ($self, $ev, $x, $y) = @_;	486	my ($self, $ev, $x, $y) = @_;
459		487
460	$self->focus_in;	488	$self->grab_focus;
461		489
462	0	490	0
		491	}
		492
		493	sub connect {
		494	my ($self, $signal, $cb) = @_;
		495
		496	push @{ $self->{signal_cb}{$signal} }, $cb;
		497	}
		498
		499	sub emit {
		500	my ($self, $signal, @args) = @_;
		501
		502	my @append
		503	= ref $args[0] && $args[0]->isa ("CFClient::UI::Event")
		504	? $args[0]->xy ($self)
		505	: ();
		506
		507	#warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
		508
		509	#d##TODO# stop propagating at first true, do not use sum
		510	(List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
		511	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append) # closure
		512	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
463	}	513	}
464		514
465	sub find_widget {	515	sub find_widget {
466	my ($self, $x, $y) = @_;	516	my ($self, $x, $y) = @_;
467		517
…		…
477	sub set_parent {	527	sub set_parent {
478	my ($self, $parent) = @_;	528	my ($self, $parent) = @_;
479		529
480	Scalar::Util::weaken ($self->{parent} = $parent);	530	Scalar::Util::weaken ($self->{parent} = $parent);
481	$self->set_visible if $parent->{visible};	531	$self->set_visible if $parent->{visible};
482	}
483
484	sub connect {
485	my ($self, $signal, $cb) = @_;
486
487	push @{ $self->{signal_cb}{$signal} }, $cb;
488	}
489
490	sub _emit {
491	my ($self, $signal, @args) = @_;
492
493	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
494	}
495
496	sub emit {
497	my ($self, $signal, @args) = @_;
498
499	$self->_emit ($signal, @args)
500	|| $self->$signal (@args);
501	}
502
503	sub visibility_change {
504	#my ($self, $visible) = @_;
505	}	532	}
506		533
507	sub realloc {	534	sub realloc {
508	my ($self) = @_;	535	my ($self) = @_;
509		536
…		…
542	return unless $self->{h} && $self->{w};	569	return unless $self->{h} && $self->{w};
543		570
544	# update screen rectangle	571	# update screen rectangle
545	local $draw_x = $draw_x + $self->{x};	572	local $draw_x = $draw_x + $self->{x};
546	local $draw_y = $draw_y + $self->{y};	573	local $draw_y = $draw_y + $self->{y};
547	local $draw_w = $draw_x + $self->{w};
548	local $draw_h = $draw_y + $self->{h};
549		574
550	# skip widgets that are entirely outside the drawing area	575	# skip widgets that are entirely outside the drawing area
551	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)	576	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
552	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);	577	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
553		578
…		…
592	}	617	}
593		618
594	sub DESTROY {	619	sub DESTROY {
595	my ($self) = @_;	620	my ($self) = @_;
596		621
		622	return if CFClient::in_destruct;
		623
597	delete $WIDGET{$self+0};	624	delete $WIDGET{$self+0};
598		625
599	eval { $self->destroy };	626	eval { $self->destroy };
600	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;	627	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
601	}	628	}
…		…
789		816
790	sub size_request {	817	sub size_request {
791	$_[0]{children}[0]->size_request	818	$_[0]{children}[0]->size_request
792	}	819	}
793		820
794	sub size_allocate {	821	sub invoke_size_allocate {
795	my ($self, $w, $h) = @_;	822	my ($self, $w, $h) = @_;
796		823
797	$self->{children}[0]->configure (0, 0, $w, $h);	824	$self->{children}[0]->configure (0, 0, $w, $h);
		825
		826	1
798	}	827	}
799		828
800	#############################################################################	829	#############################################################################
801		830
802	# back-buffered drawing area	831	# back-buffered drawing area
…		…
818		847
819	$ROOT->on_post_alloc ($self => sub { $self->render_child });	848	$ROOT->on_post_alloc ($self => sub { $self->render_child });
820	$self->SUPER::update;	849	$self->SUPER::update;
821	}	850	}
822		851
823	sub size_allocate {	852	sub invoke_size_allocate {
824	my ($self, $w, $h) = @_;	853	my ($self, $w, $h) = @_;
825		854
826	$self->SUPER::size_allocate ($w, $h);
827	$self->update;	855	$self->update;
		856
		857	$self->SUPER::invoke_size_allocate ($w, $h)
828	}	858	}
829		859
830	sub _render {	860	sub _render {
831	my ($self) = @_;	861	my ($self) = @_;
832		862
…		…
893	$h = 10 if $self->{scroll_y};	923	$h = 10 if $self->{scroll_y};
894		924
895	($w, $h)	925	($w, $h)
896	}	926	}
897		927
898	sub size_allocate {	928	sub invoke_size_allocate {
899	my ($self, $w, $h) = @_;	929	my ($self, $w, $h) = @_;
900		930
901	my $child = $self->child;	931	my $child = $self->child;
902		932
903	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};	933	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
904	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};	934	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
905		935
906	$self->child->configure (0, 0, $w, $h);	936	$self->child->configure (0, 0, $w, $h);
907	$self->update;	937	$self->update;
		938
		939	1
908	}	940	}
909		941
910	sub set_offset {	942	sub set_offset {
911	my ($self, $x, $y) = @_;	943	my ($self, $x, $y) = @_;
912		944
…		…
975	$self->{vp}->set_offset (0, $_[1]);	1007	$self->{vp}->set_offset (0, $_[1]);
976	},	1008	},
977	;	1009	;
978		1010
979	$self = $class->SUPER::new (	1011	$self = $class->SUPER::new (
980	vp => (new CFClient::UI::ViewPort expand => 1),	1012	vp => (new CFClient::UI::ViewPort expand => 1),
		1013	can_events => 1,
981	slider => $slider,	1014	slider => $slider,
982	%arg,	1015	%arg,
983	);	1016	);
984		1017
985	$self->SUPER::add ($self->{vp}, $self->{slider});	1018	$self->SUPER::add ($self->{vp}, $self->{slider});
986	$self->add ($child) if $child;	1019	$self->add ($child) if $child;
987		1020
988	$self	1021	$self
989	}	1022	}
990		1023
		1024	#TODO# update range on size_allocate depending on child
		1025
991	sub add {	1026	sub add {
992	my ($self, $widget) = @_;	1027	my ($self, $widget) = @_;
993		1028
994	$self->{vp}->add ($self->{child} = $widget);	1029	$self->{vp}->add ($self->{child} = $widget);
995	}	1030	}
996		1031
		1032	sub invoke_mouse_wheel {
		1033	my ($self, $ev) = @_;
		1034
		1035	return 0 unless $ev->{dy}; # only vertical movements
		1036
		1037	$self->{slider}->emit (mouse_wheel => $ev);
		1038
		1039	1
		1040	}
		1041
		1042	sub update_slider {
		1043	my ($self) = @_;
		1044
		1045	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
		1046	}
		1047
997	sub update {	1048	sub update {
998	my ($self) = @_;	1049	my ($self) = @_;
999		1050
1000	$self->SUPER::update;	1051	$self->SUPER::update;
1001		1052
1002	# todo: overwrite size_allocate of child	1053	$self->update_slider;
1003	my $child = $self->{vp}->child;
1004	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1005	}	1054	}
1006		1055
1007	sub size_allocate {	1056	sub invoke_size_allocate {
1008	my ($self, $w, $h) = @_;	1057	my ($self, $w, $h) = @_;
1009		1058
		1059	$self->update_slider;
		1060
1010	$self->SUPER::size_allocate ($w, $h);	1061	$self->SUPER::invoke_size_allocate ($w, $h)
1011
1012	my $child = $self->{vp}->child;
1013	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1014	}	1062	}
1015
1016	#TODO# update range on size_allocate depending on child
1017	# update viewport offset on scroll
1018		1063
1019	#############################################################################	1064	#############################################################################
1020		1065
1021	package CFClient::UI::Frame;	1066	package CFClient::UI::Frame;
1022		1067
…		…
1078	my $self = $class->SUPER::new (	1123	my $self = $class->SUPER::new (
1079	bg => [1, 1, 1, 1],	1124	bg => [1, 1, 1, 1],
1080	border_bg => [1, 1, 1, 1],	1125	border_bg => [1, 1, 1, 1],
1081	border => 0.6,	1126	border => 0.6,
1082	can_events => 1,	1127	can_events => 1,
1083	min_w => 16,	1128	min_w => 64,
1084	min_h => 16,	1129	min_h => 32,
1085	%arg,	1130	%arg,
1086	);	1131	);
1087		1132
1088	$self->{title_widget} = new CFClient::UI::Label	1133	$self->{title_widget} = new CFClient::UI::Label
1089	align => 0,	1134	align => 0,
1090	valign => 1,	1135	valign => 1,
1091	text => $self->{title},	1136	text => $self->{title},
1092	fontsize => $self->{border},	1137	fontsize => $self->{border},
1093	if exists $self->{title};	1138	if exists $self->{title};
1094		1139
		1140	if ($self->{has_close_button}) {
		1141	$self->{close_button} =
		1142	new CFClient::UI::ImageButton
		1143	path => 'x1_close.png',
		1144	on_activate => sub { $self->emit ("delete") };
		1145
		1146	$self->CFClient::UI::Container::add ($self->{close_button});
		1147	}
		1148
1095	$self	1149	$self
1096	}	1150	}
1097		1151
1098	sub add {	1152	sub add {
1099	my ($self, @widgets) = @_;	1153	my ($self, @widgets) = @_;
1100		1154
1101	$self->SUPER::add (@widgets);	1155	$self->SUPER::add (@widgets);
		1156	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1102	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};	1157	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1103	}	1158	}
1104		1159
1105	sub border {	1160	sub border {
1106	int $_[0]{border} * $::FONTSIZE	1161	int $_[0]{border} * $::FONTSIZE
…		…
1109	sub size_request {	1164	sub size_request {
1110	my ($self) = @_;	1165	my ($self) = @_;
1111		1166
1112	$self->{title_widget}->size_request	1167	$self->{title_widget}->size_request
1113	if $self->{title_widget};	1168	if $self->{title_widget};
		1169
		1170	$self->{close_button}->size_request
		1171	if $self->{close_button};
1114		1172
1115	my ($w, $h) = $self->SUPER::size_request;	1173	my ($w, $h) = $self->SUPER::size_request;
1116		1174
1117	(	1175	(
1118	$w + $self->border * 2,	1176	$w + $self->border * 2,
1119	$h + $self->border * 2,	1177	$h + $self->border * 2,
1120	)	1178	)
1121	}	1179	}
1122		1180
1123	sub size_allocate {	1181	sub invoke_size_allocate {
1124	my ($self, $w, $h) = @_;	1182	my ($self, $w, $h) = @_;
1125		1183
1126	if ($self->{title_widget}) {	1184	if ($self->{title_widget}) {
1127	$self->{title_widget}{w} = $w;	1185	$self->{title_widget}{w} = $w;
1128	$self->{title_widget}{h} = $h;	1186	$self->{title_widget}{h} = $h;
1129	$self->{title_widget}->size_allocate ($w, $h);	1187	$self->{title_widget}->invoke_size_allocate ($w, $h);
1130	}	1188	}
1131		1189
1132	my $border = $self->border;	1190	my $border = $self->border;
1133		1191
1134	$h -= List::Util::max 0, $border * 2;	1192	$h -= List::Util::max 0, $border * 2;
1135	$w -= List::Util::max 0, $border * 2;	1193	$w -= List::Util::max 0, $border * 2;
		1194
		1195	$self->child->configure ($border, $border, $w, $h);
		1196
		1197	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1198	if $self->{close_button};
		1199
		1200	1
		1201	}
		1202
		1203	sub invoke_delete {
		1204	my ($self) = @_;
		1205
		1206	$self->hide;
1136		1207
1137	$self->child->configure ($border, $border, $w, $h);	1208	1
1138	}	1209	}
1139		1210
1140	sub button_down {	1211	sub invoke_button_down {
1141	my ($self, $ev, $x, $y) = @_;	1212	my ($self, $ev, $x, $y) = @_;
1142		1213
1143	my ($w, $h) = @$self{qw(w h)};	1214	my ($w, $h) = @$self{qw(w h)};
1144	my $border = $self->border;	1215	my $border = $self->border;
1145		1216
…		…
1176		1247
1177	($x, $y) = ($ev->{x}, $ev->{y});	1248	($x, $y) = ($ev->{x}, $ev->{y});
1178		1249
1179	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1250	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1180	# HACK: the next line is required to enforce placement	1251	# HACK: the next line is required to enforce placement
1181	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1252	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1182	};	1253	};
1183	} else {	1254	} else {
1184	return 0;	1255	return 0;
1185	}	1256	}
1186		1257
1187	1	1258	1
1188	}	1259	}
1189		1260
1190	sub button_up {	1261	sub invoke_button_up {
1191	my ($self, $ev, $x, $y) = @_;	1262	my ($self, $ev, $x, $y) = @_;
1192		1263
1193	!!delete $self->{motion}	1264	! ! delete $self->{motion}
1194	}	1265	}
1195		1266
1196	sub mouse_motion {	1267	sub invoke_mouse_motion {
1197	my ($self, $ev, $x, $y) = @_;	1268	my ($self, $ev, $x, $y) = @_;
1198		1269
1199	$self->{motion}->($ev, $x, $y) if $self->{motion};	1270	$self->{motion}->($ev, $x, $y) if $self->{motion};
1200		1271
1201	!!$self->{motion}	1272	! ! $self->{motion}
1202	}	1273	}
1203		1274
1204	sub _draw {	1275	sub _draw {
1205	my ($self) = @_;	1276	my ($self) = @_;
1206		1277
…		…
1235	$child->draw;	1306	$child->draw;
1236		1307
1237	if ($self->{title_widget}) {	1308	if ($self->{title_widget}) {
1238	glTranslate 0, $border - $self->{h};	1309	glTranslate 0, $border - $self->{h};
1239	$self->{title_widget}->_draw;	1310	$self->{title_widget}->_draw;
		1311
		1312	glTranslate 0, - ($border - $self->{h});
1240	}	1313	}
		1314
		1315	$self->{close_button}->draw
		1316	if $self->{close_button};
1241	}	1317	}
1242		1318
1243	#############################################################################	1319	#############################################################################
1244		1320
1245	package CFClient::UI::Table;	1321	package CFClient::UI::Table;
…		…
1324	(sum @$ws),	1400	(sum @$ws),
1325	(sum @$hs),	1401	(sum @$hs),
1326	)	1402	)
1327	}	1403	}
1328		1404
1329	sub size_allocate {	1405	sub invoke_size_allocate {
1330	my ($self, $w, $h) = @_;	1406	my ($self, $w, $h) = @_;
1331		1407
1332	my ($ws, $hs) = $self->get_wh;	1408	my ($ws, $hs) = $self->get_wh;
1333		1409
1334	my $req_w = (sum @$ws) || 1;	1410	my $req_w = (sum @$ws) || 1;
…		…
1366	}	1442	}
1367		1443
1368	$y += $row_h;	1444	$y += $row_h;
1369	}	1445	}
1370		1446
		1447	1
1371	}	1448	}
1372		1449
1373	sub find_widget {	1450	sub find_widget {
1374	my ($self, $x, $y) = @_;	1451	my ($self, $x, $y) = @_;
1375		1452
…		…
1412	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1489	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1413	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1490	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1414	)	1491	)
1415	}	1492	}
1416		1493
1417	sub size_allocate {	1494	sub invoke_size_allocate {
1418	my ($self, $w, $h) = @_;	1495	my ($self, $w, $h) = @_;
1419		1496
1420	my $space = $self->{vertical} ? $h : $w;	1497	my $space = $self->{vertical} ? $h : $w;
1421	my $children = $self->{children};	1498	my @children = $self->visible_children;
1422		1499
1423	my @req;	1500	my @req;
1424		1501
1425	if ($self->{homogeneous}) {	1502	if ($self->{homogeneous}) {
1426	@req = ($space / (@$children || 1)) x @$children;	1503	@req = ($space / (@children || 1)) x @children;
1427	} else {	1504	} else {
1428	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1505	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1429	my $req = List::Util::sum @req;	1506	my $req = List::Util::sum @req;
1430		1507
1431	if ($req > $space) {	1508	if ($req > $space) {
1432	# ah well, not enough space	1509	# ah well, not enough space
1433	$_ *= $space / $req for @req;	1510	$_ *= $space / $req for @req;
1434	} else {	1511	} else {
1435	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1512	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1436		1513
1437	$space = ($space - $req) / $expand; # remaining space to give away	1514	$space = ($space - $req) / $expand; # remaining space to give away
1438		1515
1439	$req[$_] += $space * $children->[$_]{expand}	1516	$req[$_] += $space * $children[$_]{expand}
1440	for 0 .. $#$children;	1517	for 0 .. $#children;
1441	}	1518	}
1442	}	1519	}
1443		1520
1444	CFClient::UI::harmonize \@req;	1521	CFClient::UI::harmonize \@req;
1445		1522
1446	my $pos = 0;	1523	my $pos = 0;
1447	for (0 .. $#$children) {	1524	for (0 .. $#children) {
1448	my $alloc = $req[$_];	1525	my $alloc = $req[$_];
1449	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1526	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1450		1527
1451	$pos += $alloc;	1528	$pos += $alloc;
1452	}	1529	}
1453		1530
1454	1	1531	1
…		…
1557	my ($self, $text) = @_;	1634	my ($self, $text) = @_;
1558		1635
1559	return if $self->{text} eq "T$text";	1636	return if $self->{text} eq "T$text";
1560	$self->{text} = "T$text";	1637	$self->{text} = "T$text";
1561		1638
1562	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1563	$self->{layout}->set_text ($text);	1639	$self->{layout}->set_text ($text);
1564		1640
1565	delete $self->{size_req};	1641	delete $self->{size_req};
1566	$self->realloc;	1642	$self->realloc;
1567	$self->update;	1643	$self->update;
…		…
1573	return if $self->{text} eq "M$markup";	1649	return if $self->{text} eq "M$markup";
1574	$self->{text} = "M$markup";	1650	$self->{text} = "M$markup";
1575		1651
1576	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1652	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1577		1653
1578	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1579	$self->{layout}->set_markup ($markup);	1654	$self->{layout}->set_markup ($markup);
1580		1655
1581	delete $self->{size_req};	1656	delete $self->{size_req};
1582	$self->realloc;	1657	$self->realloc;
1583	$self->update;	1658	$self->update;
…		…
1595		1670
1596	my ($w, $h) = $self->{layout}->size;	1671	my ($w, $h) = $self->{layout}->size;
1597		1672
1598	if (exists $self->{template}) {	1673	if (exists $self->{template}) {
1599	$self->{template}->set_font ($self->{font}) if $self->{font};	1674	$self->{template}->set_font ($self->{font}) if $self->{font};
		1675	$self->{template}->set_width ($self->{max_w} || -1);
1600	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1676	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1601		1677
1602	my ($w2, $h2) = $self->{template}->size;	1678	my ($w2, $h2) = $self->{template}->size;
1603		1679
1604	$w = List::Util::max $w, $w2;	1680	$w = List::Util::max $w, $w2;
…		…
1609	};	1685	};
1610		1686
1611	@{ $self->{size_req} }	1687	@{ $self->{size_req} }
1612	}	1688	}
1613		1689
		1690	sub baseline_shift {
		1691	$_[0]{layout}->descent
		1692	}
		1693
1614	sub size_allocate {	1694	sub invoke_size_allocate {
1615	my ($self, $w, $h) = @_;	1695	my ($self, $w, $h) = @_;
1616		1696
1617	delete $self->{ox};	1697	delete $self->{ox};
1618		1698
1619	delete $self->{texture}	1699	delete $self->{texture}
1620	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};	1700	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1701
		1702	1
1621	}	1703	}
1622		1704
1623	sub set_fontsize {	1705	sub set_fontsize {
1624	my ($self, $fontsize) = @_;	1706	my ($self, $fontsize) = @_;
1625		1707
1626	$self->{fontsize} = $fontsize;	1708	$self->{fontsize} = $fontsize;
		1709	delete $self->{size_req};
1627	delete $self->{texture};	1710	delete $self->{texture};
1628		1711
1629	$self->realloc;	1712	$self->realloc;
1630	}	1713	}
1631		1714
1632	sub reconfigure {	1715	sub reconfigure {
1633	my ($self) = @_;	1716	my ($self) = @_;
1634		1717
1635	delete $self->{size_req};	1718	delete $self->{size_req};
		1719	delete $self->{texture};
1636		1720
1637	$self->SUPER::reconfigure;	1721	$self->SUPER::reconfigure;
1638	}	1722	}
1639		1723
1640	sub _draw {	1724	sub _draw {
1641	my ($self) = @_;	1725	my ($self) = @_;
1642		1726
1643	$self->SUPER::_draw; # draw background, if applicable	1727	$self->SUPER::_draw; # draw background, if applicable
1644		1728
1645	my $tex = $self->{texture} ||= do {	1729	my $size = $self->{texture} ||= do {
1646	$self->{layout}->set_foreground (@{$self->{fg}});	1730	$self->{layout}->set_foreground (@{$self->{fg}});
1647	$self->{layout}->set_font ($self->{font}) if $self->{font};	1731	$self->{layout}->set_font ($self->{font}) if $self->{font};
1648	$self->{layout}->set_width ($self->{w});	1732	$self->{layout}->set_width ($self->{w});
1649	$self->{layout}->set_ellipsise ($self->{ellipsise});	1733	$self->{layout}->set_ellipsise ($self->{ellipsise});
1650	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1734	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1651	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1735	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1652		1736
1653	new_from_layout CFClient::Texture $self->{layout}	1737	[$self->{layout}->size]
1654	};	1738	};
1655		1739
1656	unless (exists $self->{ox}) {	1740	unless (exists $self->{ox}) {
1657	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1741	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1658	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1742	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1659	: ($self->{w} - $tex->{w}) * 0.5);	1743	: ($self->{w} - $size->[0]) * 0.5);
1660		1744
1661	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1745	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1662	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1746	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1663	: ($self->{h} - $tex->{h}) * 0.5);	1747	: ($self->{h} - $size->[1]) * 0.5);
1664	};	1748	};
1665		1749
1666	glEnable GL_TEXTURE_2D;
1667
1668	my $w = List::Util::min $self->{w} + 4, $tex->{w};	1750	my $w = List::Util::min $self->{w} + 4, $size->[0];
1669	my $h = List::Util::min $self->{h} + 2, $tex->{h};	1751	my $h = List::Util::min $self->{h} + 2, $size->[1];
1670		1752
1671	if ($tex->{format} == GL_ALPHA) {	1753	$self->{layout}->render ($self->{ox}, $self->{oy});
1672	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1673	glColor @{$self->{fg}};
1674	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1675	} else {
1676	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1677	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1678	}
1679
1680	glDisable GL_TEXTURE_2D;
1681	}	1754	}
1682		1755
1683	#############################################################################	1756	#############################################################################
1684		1757
1685	package CFClient::UI::EntryBase;	1758	package CFClient::UI::EntryBase;
…		…
1718		1791
1719	$text =~ s/./*/g if $self->{hidden};	1792	$text =~ s/./*/g if $self->{hidden};
1720	$self->{layout}->set_text ("$text ");	1793	$self->{layout}->set_text ("$text ");
1721	delete $self->{size_req};	1794	delete $self->{size_req};
1722		1795
1723	$self->_emit (changed => $self->{text});	1796	$self->emit (changed => $self->{text});
1724		1797
1725	$self->realloc;	1798	$self->realloc;
1726	$self->update;	1799	$self->update;
1727	}	1800	}
1728		1801
…		…
1743	my ($w, $h) = $self->SUPER::size_request;	1816	my ($w, $h) = $self->SUPER::size_request;
1744		1817
1745	($w + 1, $h) # add 1 for cursor	1818	($w + 1, $h) # add 1 for cursor
1746	}	1819	}
1747		1820
1748	sub key_down {	1821	sub invoke_key_down {
1749	my ($self, $ev) = @_;	1822	my ($self, $ev) = @_;
1750		1823
1751	my $mod = $ev->{mod};	1824	my $mod = $ev->{mod};
1752	my $sym = $ev->{sym};	1825	my $sym = $ev->{sym};
1753	my $uni = $ev->{unicode};	1826	my $uni = $ev->{unicode};
…		…
1765	} elsif ($sym == CFClient::SDLK_HOME) {	1838	} elsif ($sym == CFClient::SDLK_HOME) {
1766	$self->{cursor} = 0;	1839	$self->{cursor} = 0;
1767	} elsif ($sym == CFClient::SDLK_END) {	1840	} elsif ($sym == CFClient::SDLK_END) {
1768	$self->{cursor} = length $text;	1841	$self->{cursor} = length $text;
1769	} elsif ($uni == 27) {	1842	} elsif ($uni == 27) {
1770	$self->_emit ('escape');	1843	$self->emit ('escape');
1771	} elsif ($uni) {	1844	} elsif ($uni) {
1772	substr $text, $self->{cursor}++, 0, chr $uni;	1845	substr $text, $self->{cursor}++, 0, chr $uni;
1773	} else {	1846	} else {
1774	return 0;	1847	return 0;
1775	}	1848	}
…		…
1779	$self->realloc;	1852	$self->realloc;
1780		1853
1781	1	1854	1
1782	}	1855	}
1783		1856
1784	sub focus_in {	1857	sub invoke_focus_in {
1785	my ($self) = @_;	1858	my ($self) = @_;
1786		1859
1787	$self->{last_activity} = $::NOW;	1860	$self->{last_activity} = $::NOW;
1788		1861
1789	$self->SUPER::focus_in;	1862	$self->SUPER::invoke_focus_in
1790	}	1863	}
1791		1864
1792	sub button_down {	1865	sub invoke_button_down {
1793	my ($self, $ev, $x, $y) = @_;	1866	my ($self, $ev, $x, $y) = @_;
1794		1867
1795	$self->SUPER::button_down ($ev, $x, $y);	1868	$self->SUPER::invoke_button_down ($ev, $x, $y);
1796		1869
1797	my $idx = $self->{layout}->xy_to_index ($x, $y);	1870	my $idx = $self->{layout}->xy_to_index ($x, $y);
1798		1871
1799	# byte-index to char-index	1872	# byte-index to char-index
1800	my $text = $self->{text};	1873	my $text = $self->{text};
1801	utf8::encode $text;	1874	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1802	$self->{cursor} = length substr $text, 0, $idx;	1875	$self->{cursor} = length $text;
1803		1876
1804	$self->_set_text ($self->{text});	1877	$self->_set_text ($self->{text});
1805	$self->update;	1878	$self->update;
1806		1879
1807	1	1880	1
1808	}	1881	}
1809		1882
1810	sub mouse_motion {	1883	sub invoke_mouse_motion {
1811	my ($self, $ev, $x, $y) = @_;	1884	my ($self, $ev, $x, $y) = @_;
1812	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1885	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1813		1886
1814	0	1887	1
1815	}	1888	}
1816		1889
1817	sub _draw {	1890	sub _draw {
1818	my ($self) = @_;	1891	my ($self) = @_;
1819		1892
…		…
1860		1933
1861	our @ISA = CFClient::UI::EntryBase::;	1934	our @ISA = CFClient::UI::EntryBase::;
1862		1935
1863	use CFClient::OpenGL;	1936	use CFClient::OpenGL;
1864		1937
1865	sub key_down {	1938	sub invoke_key_down {
1866	my ($self, $ev) = @_;	1939	my ($self, $ev) = @_;
1867		1940
1868	my $sym = $ev->{sym};	1941	my $sym = $ev->{sym};
1869		1942
1870	if ($sym == 13) {	1943	if ($sym == 13) {
1871	unshift @{$self->{history}},	1944	unshift @{$self->{history}},
1872	my $txt = $self->get_text;	1945	my $txt = $self->get_text;
		1946
1873	$self->{history_pointer} = -1;	1947	$self->{history_pointer} = -1;
1874	$self->{history_saveback} = '';	1948	$self->{history_saveback} = '';
1875	$self->_emit (activate => $txt);	1949	$self->emit (activate => $txt);
1876	$self->update;	1950	$self->update;
1877		1951
1878	} elsif ($sym == CFClient::SDLK_UP) {	1952	} elsif ($sym == CFClient::SDLK_UP) {
1879	if ($self->{history_pointer} < 0) {	1953	if ($self->{history_pointer} < 0) {
1880	$self->{history_saveback} = $self->get_text;	1954	$self->{history_saveback} = $self->get_text;
…		…
1896	} else {	1970	} else {
1897	$self->set_text ($self->{history_saveback});	1971	$self->set_text ($self->{history_saveback});
1898	}	1972	}
1899		1973
1900	} else {	1974	} else {
1901	return $self->SUPER::key_down ($ev)	1975	return $self->SUPER::invoke_key_down ($ev)
1902	}	1976	}
1903		1977
1904	1	1978	1
1905	}	1979	}
1906		1980
…		…
1930	can_events => 1,	2004	can_events => 1,
1931	@_	2005	@_
1932	)	2006	)
1933	}	2007	}
1934		2008
1935	sub activate { }
1936
1937	sub button_up {	2009	sub invoke_button_up {
1938	my ($self, $ev, $x, $y) = @_;	2010	my ($self, $ev, $x, $y) = @_;
1939		2011
1940	$self->emit ("activate")	2012	$self->emit ("activate")
1941	if $x >= 0 && $x < $self->{w}	2013	if $x >= 0 && $x < $self->{w}
1942	&& $y >= 0 && $y < $self->{h};	2014	&& $y >= 0 && $y < $self->{h};
…		…
1956	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2028	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1957		2029
1958	glDisable GL_TEXTURE_2D;	2030	glDisable GL_TEXTURE_2D;
1959		2031
1960	$self->SUPER::_draw;	2032	$self->SUPER::_draw;
		2033	}
		2034
		2035	#############################################################################
		2036
		2037	package CFClient::UI::ImageButton;
		2038
		2039	our @ISA = CFClient::UI::Image::;
		2040
		2041	use CFClient::OpenGL;
		2042
		2043	my %textures;
		2044
		2045	sub new {
		2046	my $class = shift;
		2047
		2048	my $self = $class->SUPER::new (
		2049	padding_x => 4,
		2050	padding_y => 4,
		2051	fg => [1, 1, 1],
		2052	active_fg => [0, 0, 1],
		2053	can_hover => 1,
		2054	align => 0,
		2055	valign => 0,
		2056	can_events => 1,
		2057	@_
		2058	);
		2059	}
		2060
		2061	sub invoke_button_up {
		2062	my ($self, $ev, $x, $y) = @_;
		2063
		2064	$self->emit ("activate")
		2065	if $x >= 0 && $x < $self->{w}
		2066	&& $y >= 0 && $y < $self->{h};
		2067
		2068	1
1961	}	2069	}
1962		2070
1963	#############################################################################	2071	#############################################################################
1964		2072
1965	package CFClient::UI::CheckBox;	2073	package CFClient::UI::CheckBox;
…		…
1992	my ($self) = @_;	2100	my ($self) = @_;
1993		2101
1994	(6) x 2	2102	(6) x 2
1995	}	2103	}
1996		2104
		2105	sub toggle {
		2106	my ($self) = @_;
		2107
		2108	$self->{state} = !$self->{state};
		2109	$self->emit (changed => $self->{state});
		2110	$self->update;
		2111	}
		2112
1997	sub button_down {	2113	sub invoke_button_down {
1998	my ($self, $ev, $x, $y) = @_;	2114	my ($self, $ev, $x, $y) = @_;
1999		2115
2000	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2116	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2001	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2117	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2002	$self->{state} = !$self->{state};	2118	$self->toggle;
2003	$self->_emit (changed => $self->{state});
2004	} else {	2119	} else {
2005	return 0	2120	return 0
2006	}	2121	}
2007		2122
2008	1	2123	1
…		…
2033	package CFClient::UI::Image;	2148	package CFClient::UI::Image;
2034		2149
2035	our @ISA = CFClient::UI::Base::;	2150	our @ISA = CFClient::UI::Base::;
2036		2151
2037	use CFClient::OpenGL;	2152	use CFClient::OpenGL;
2038	use Carp qw/confess/;
2039		2153
2040	our %loaded_images;	2154	our %texture_cache;
2041		2155
2042	sub new {	2156	sub new {
2043	my $class = shift;	2157	my $class = shift;
2044		2158
2045	my $self = $class->SUPER::new (can_events => 0, @_);	2159	my $self = $class->SUPER::new (
		2160	can_events => 0,
		2161	@_,
		2162	);
2046		2163
2047	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2164	$self->{path} || $self->{tex}
		2165	or Carp::croak "'path' or 'tex' attributes required";
2048		2166
2049	$loaded_images{$self->{image}} ||=	2167	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2050	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2168	new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2051		2169
2052	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2170	Scalar::Util::weaken $texture_cache{$self->{path}};
2053		2171
2054	Scalar::Util::weaken $loaded_images{$self->{image}};	2172	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2055
2056	$self->{aspect} = $tex->{w} / $tex->{h};
2057		2173
2058	$self	2174	$self
2059	}	2175	}
2060		2176
2061	sub size_request {	2177	sub size_request {
2062	my ($self) = @_;	2178	my ($self) = @_;
2063		2179
2064	($self->{tex}->{w}, $self->{tex}->{h})	2180	($self->{tex}{w}, $self->{tex}{h})
2065	}	2181	}
2066		2182
2067	sub _draw {	2183	sub _draw {
2068	my ($self) = @_;	2184	my ($self) = @_;
2069		2185
…		…
2178	my $ycut1 = max 0, min 1, $ycut;	2294	my $ycut1 = max 0, min 1, $ycut;
2179	my $ycut2 = max 0, min 1, $ycut - 1;	2295	my $ycut2 = max 0, min 1, $ycut - 1;
2180		2296
2181	my $h1 = $self->{h} * (1 - $ycut1);	2297	my $h1 = $self->{h} * (1 - $ycut1);
2182	my $h2 = $self->{h} * (1 - $ycut2);	2298	my $h2 = $self->{h} * (1 - $ycut2);
		2299	my $h3 = $self->{h};
		2300
		2301	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2183		2302
2184	glEnable GL_BLEND;	2303	glEnable GL_BLEND;
2185	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2304	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2186	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2305	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2187	glEnable GL_TEXTURE_2D;	2306	glEnable GL_TEXTURE_2D;
…		…
2206		2325
2207	if ($t3) {	2326	if ($t3) {
2208	glBindTexture GL_TEXTURE_2D, $t3->{name};	2327	glBindTexture GL_TEXTURE_2D, $t3->{name};
2209	glBegin GL_QUADS;	2328	glBegin GL_QUADS;
2210	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2329	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2211	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2330	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2212	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2331	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2213	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2332	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2214	glEnd;	2333	glEnd;
2215	}	2334	}
2216		2335
2217	glDisable GL_BLEND;	2336	glDisable GL_BLEND;
…		…
2305	$self->update;	2424	$self->update;
2306		2425
2307	$self	2426	$self
2308	}	2427	}
2309		2428
2310	sub changed { }
2311
2312	sub set_range {	2429	sub set_range {
2313	my ($self, $range) = @_;	2430	my ($self, $range) = @_;
2314		2431
2315	($range, $self->{range}) = ($self->{range}, $range);	2432	($range, $self->{range}) = ($self->{range}, $range);
2316		2433
…		…
2336	if $unit;	2453	if $unit;
2337		2454
2338	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2455	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2339		2456
2340	if ($value != $old_value) {	2457	if ($value != $old_value) {
2341	$self->_emit (changed => $value);	2458	$self->emit (changed => $value);
2342	$self->update;	2459	$self->update;
2343	}	2460	}
2344	}	2461	}
2345		2462
2346	sub size_request {	2463	sub size_request {
2347	my ($self) = @_;	2464	my ($self) = @_;
2348		2465
2349	($self->{req_w}, $self->{req_h})	2466	($self->{req_w}, $self->{req_h})
2350	}	2467	}
2351		2468
2352	sub button_down {	2469	sub invoke_button_down {
2353	my ($self, $ev, $x, $y) = @_;	2470	my ($self, $ev, $x, $y) = @_;
2354		2471
2355	$self->SUPER::button_down ($ev, $x, $y);	2472	$self->SUPER::invoke_button_down ($ev, $x, $y);
2356		2473
2357	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2474	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2358		2475
2359	$self->mouse_motion ($ev, $x, $y)	2476	$self->invoke_mouse_motion ($ev, $x, $y)
2360	}	2477	}
2361		2478
2362	sub mouse_motion {	2479	sub invoke_mouse_motion {
2363	my ($self, $ev, $x, $y) = @_;	2480	my ($self, $ev, $x, $y) = @_;
2364		2481
2365	if ($GRAB == $self) {	2482	if ($GRAB == $self) {
2366	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2483	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2367		2484
…		…
2373	} else {	2490	} else {
2374	return 0;	2491	return 0;
2375	}	2492	}
2376		2493
2377	1	2494	1
		2495	}
		2496
		2497	sub invoke_mouse_wheel {
		2498	my ($self, $ev) = @_;
		2499
		2500	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2501
		2502	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.1);
		2503
		2504	! ! $delta
2378	}	2505	}
2379		2506
2380	sub update {	2507	sub update {
2381	my ($self) = @_;	2508	my ($self) = @_;
2382		2509
…		…
2483	sub new {	2610	sub new {
2484	my $class = shift;	2611	my $class = shift;
2485		2612
2486	my $self = $class->SUPER::new (	2613	my $self = $class->SUPER::new (
2487	fontsize => 1,	2614	fontsize => 1,
2488	can_events => 0,	2615	can_events => 1,
2489	indent => 0,	2616	indent => 0,
2490	#font => default_font	2617	#font => default_font
2491	@_,	2618	@_,
2492		2619
2493	layout => (new CFClient::Layout 1),	2620	layout => (new CFClient::Layout),
2494	par => [],	2621	par => [],
2495	height => 0,	2622	height => 0,
2496	children => [	2623	children => [
2497	(new CFClient::UI::Empty expand => 1),	2624	(new CFClient::UI::Empty expand => 1),
2498	(new CFClient::UI::Slider vertical => 1),	2625	(new CFClient::UI::Slider vertical => 1),
…		…
2509		2636
2510	$self->{fontsize} = $fontsize;	2637	$self->{fontsize} = $fontsize;
2511	$self->reflow;	2638	$self->reflow;
2512	}	2639	}
2513		2640
		2641	sub size_request {
		2642	my ($self) = @_;
		2643
		2644	my ($empty, $slider) = @{ $self->{children} };
		2645
		2646	local $self->{children} = [$empty, $slider];
		2647	$self->SUPER::size_request
		2648	}
		2649
2514	sub size_allocate {	2650	sub invoke_size_allocate {
2515	my ($self, $w, $h) = @_;	2651	my ($self, $w, $h) = @_;
2516		2652
2517	$self->SUPER::size_allocate ($w, $h);	2653	my ($empty, $slider, @other) = @{ $self->{children} };
		2654	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2518		2655
2519	$self->{layout}->set_font ($self->{font}) if $self->{font};	2656	$self->{layout}->set_font ($self->{font}) if $self->{font};
2520	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2657	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2521	$self->{layout}->set_width ($self->{children}[0]{w});	2658	$self->{layout}->set_width ($empty->{w});
2522	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2659	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2523		2660
2524	$self->reflow;	2661	$self->reflow;
2525	}
2526		2662
2527	sub text_size {	2663	local $self->{children} = [$empty, $slider];
		2664	$self->SUPER::invoke_size_allocate ($w, $h)
		2665	}
		2666
		2667	sub invoke_mouse_wheel {
2528	my ($self, $text, $indent) = @_;	2668	my ($self, $ev) = @_;
		2669
		2670	return 0 unless $ev->{dy}; # only vertical movements
		2671
		2672	$self->{children}[1]->emit (mouse_wheel => $ev);
		2673
		2674	1
		2675	}
		2676
		2677	sub get_layout {
		2678	my ($self, $para) = @_;
2529		2679
2530	my $layout = $self->{layout};	2680	my $layout = $self->{layout};
2531		2681
		2682	$layout->set_font ($self->{font}) if $self->{font};
		2683	$layout->set_foreground (@{$para->{fg}});
2532	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2684	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2533	$layout->set_width ($self->{children}[0]{w} - $indent);	2685	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2534	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2686	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2535	$layout->set_markup ($text);	2687	$layout->set_markup ($para->{markup});
		2688
		2689	$layout->set_shapes (
		2690	map
		2691	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		2692	@{$para->{widget}}
2536		2693	);
		2694
2537	$layout->size	2695	$layout
2538	}	2696	}
2539		2697
2540	sub reflow {	2698	sub reflow {
2541	my ($self) = @_;	2699	my ($self) = @_;
2542		2700
…		…
2551	$self->{children}[1]->set_value ($offset);	2709	$self->{children}[1]->set_value ($offset);
2552	}	2710	}
2553		2711
2554	sub clear {	2712	sub clear {
2555	my ($self) = @_;	2713	my ($self) = @_;
		2714
		2715	my (undef, undef, @other) = @{ $self->{children} };
		2716	$self->remove ($_) for @other;
2556		2717
2557	$self->{par} = [];	2718	$self->{par} = [];
2558	$self->{height} = 0;	2719	$self->{height} = 0;
2559	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2720	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2560	}	2721	}
2561		2722
2562	sub add_paragraph {	2723	sub add_paragraph {
2563	my ($self, $color, $text, $indent) = @_;	2724	my ($self, $color, $para, $indent) = @_;
2564		2725
2565	for my $line (split /\n/, $text) {	2726	my ($text, @w) = ref $para ? @$para : $para;
2566	my ($w, $h) = $self->text_size ($line);	2727
2567	$self->{height} += $h;	2728	$para = {
2568	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	2729	w => 1e10,
		2730	wrapped => 1,
		2731	fg => $color,
		2732	indent => $indent,
		2733	markup => $text,
		2734	widget => \@w,
2569	}	2735	};
2570		2736
2571	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	2737	$self->add (@w) if @w;
		2738	push @{$self->{par}}, $para;
		2739
		2740	$self->{need_reflow}++;
		2741	$self->update;
		2742	}
		2743
		2744	sub scroll_to_bottom {
		2745	my ($self) = @_;
		2746
		2747	$self->{scroll_to_bottom} = 1;
		2748	$self->update;
2572	}	2749	}
2573		2750
2574	sub update {	2751	sub update {
2575	my ($self) = @_;	2752	my ($self) = @_;
2576		2753
…		…
2584	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2761	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2585		2762
2586	if (delete $self->{need_reflow}) {	2763	if (delete $self->{need_reflow}) {
2587	my $height = 0;	2764	my $height = 0;
2588		2765
2589	my $layout = $self->{layout};
2590
2591	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2592
2593	for (@{$self->{par}}) {	2766	for my $para (@{$self->{par}}) {
2594	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2767	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2595	$layout->set_width ($W - $_->[3]);	2768	my $layout = $self->get_layout ($para);
2596	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2597	$layout->set_markup ($_->[4]);
2598	my ($w, $h) = $layout->size;	2769	my ($w, $h) = $layout->size;
2599	$_->[0] = $w + $_->[3];	2770
2600	$_->[1] = $h;	2771	$para->{w} = $w + $para->{indent};
		2772	$para->{h} = $h;
		2773	$para->{wrapped} = $layout->has_wrapped;
2601	}	2774	}
2602		2775
2603	$height += $_->[1];	2776	$height += $para->{h};
2604	}	2777	}
2605		2778
2606	$self->{height} = $height;	2779	$self->{height} = $height;
2607		2780
2608	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2781	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2609		2782
2610	delete $self->{texture};	2783	delete $self->{texture};
		2784	}
		2785
		2786	if (delete $self->{scroll_to_bottom}) {
		2787	$self->{children}[1]->set_value (1e10);
2611	}	2788	}
2612		2789
2613	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2790	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2614	glClearColor 0, 0, 0, 0;	2791	glClearColor 0, 0, 0, 0;
2615	glClear GL_COLOR_BUFFER_BIT;	2792	glClear GL_COLOR_BUFFER_BIT;
…		…
2619	my $y0 = $top;	2796	my $y0 = $top;
2620	my $y1 = $top + $H;	2797	my $y1 = $top + $H;
2621		2798
2622	my $y = 0;	2799	my $y = 0;
2623		2800
2624	my $layout = $self->{layout};
2625
2626	$layout->set_font ($self->{font}) if $self->{font};
2627
2628	glEnable GL_BLEND;
2629	#TODO# not correct in windows where rgba is forced off
2630	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2631
2632	for my $par (@{$self->{par}}) {	2801	for my $para (@{$self->{par}}) {
2633	my $h = $par->[1];	2802	my $h = $para->{h};
2634		2803
2635	if ($y0 < $y + $h && $y < $y1) {	2804	if ($y0 < $y + $h && $y < $y1) {
2636	$layout->set_foreground (@{ $par->[2] });
2637	$layout->set_width ($W - $par->[3]);
2638	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2639	$layout->set_markup ($par->[4]);
2640		2805
2641	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2806	my $layout = $self->get_layout ($para);
2642		2807
2643	glRasterPos $par->[3], $y - $y0;	2808	$layout->render ($para->{indent}, $y - $y0);
2644	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	2809
		2810	if (my @w = @{ $para->{widget} }) {
		2811	my @s = $layout->get_shapes;
		2812
		2813	for (@w) {
		2814	my ($dx, $dy) = splice @s, 0, 2, ();
		2815
		2816	$_->{x} = $dx + $para->{indent};
		2817	$_->{y} = $dy + $y - $y0;
		2818
		2819	$_->draw;
		2820	}
		2821	}
2645	}	2822	}
2646		2823
2647	$y += $h;	2824	$y += $h;
2648	}	2825	}
2649
2650	glDisable GL_BLEND;
2651	};	2826	};
2652	});	2827	});
		2828	}
		2829
		2830	sub reconfigure {
		2831	my ($self) = @_;
		2832
		2833	$self->SUPER::reconfigure;
		2834
		2835	$_->{w} = 1e10 for @{ $self->{par} };
		2836	$self->reflow;
2653	}	2837	}
2654		2838
2655	sub _draw {	2839	sub _draw {
2656	my ($self) = @_;	2840	my ($self) = @_;
2657		2841
…		…
2660	glColor 0, 0, 0, 1;	2844	glColor 0, 0, 0, 1;
2661	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2845	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2662	glDisable GL_TEXTURE_2D;	2846	glDisable GL_TEXTURE_2D;
2663		2847
2664	$self->{children}[1]->draw;	2848	$self->{children}[1]->draw;
2665
2666	}	2849	}
2667		2850
2668	#############################################################################	2851	#############################################################################
2669		2852
2670	package CFClient::UI::Animator;	2853	package CFClient::UI::Animator;
…		…
2779	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2962	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2780		2963
2781	($w + 4, $h + 4)	2964	($w + 4, $h + 4)
2782	}	2965	}
2783		2966
2784	sub size_allocate {	2967	sub invoke_size_allocate {
2785	my ($self, $w, $h) = @_;	2968	my ($self, $w, $h) = @_;
2786		2969
2787	$self->SUPER::size_allocate ($w - 4, $h - 4);	2970	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2788	}	2971	}
2789		2972
2790	sub visibility_change {	2973	sub invoke_visibility_change {
2791	my ($self, $visible) = @_;	2974	my ($self, $visible) = @_;
2792		2975
2793	return unless $visible;	2976	return unless $visible;
2794		2977
2795	$self->{root}->on_post_alloc ("move_$self" => sub {	2978	$self->{root}->on_post_alloc ("move_$self" => sub {
…		…
2943	for my $item (@{ $self->{items} }) {	3126	for my $item (@{ $self->{items} }) {
2944	my ($widget, $cb, $tooltip) = @$item;	3127	my ($widget, $cb, $tooltip) = @$item;
2945		3128
2946	# handle various types of items, only text for now	3129	# handle various types of items, only text for now
2947	if (!ref $widget) {	3130	if (!ref $widget) {
		3131	if ($widget =~ /\t/) {
		3132	my ($left, $right) = split /\t/, $widget, 2;
		3133
		3134	$widget = new CFClient::UI::HBox
		3135	can_hover => 1,
		3136	can_events => 1,
		3137	tooltip => $tooltip,
		3138	children => [
		3139	(new CFClient::UI::Label markup => $left, expand => 1),
		3140	(new CFClient::UI::Label markup => $right, align => +1),
		3141	],
		3142	;
		3143
		3144	} else {
2948	$widget = new CFClient::UI::Label	3145	$widget = new CFClient::UI::Label
2949	can_hover => 1,	3146	can_hover => 1,
2950	can_events => 1,	3147	can_events => 1,
2951	markup => $widget,	3148	markup => $widget,
2952	tooltip => $tooltip	3149	tooltip => $tooltip;
		3150	}
2953	}	3151	}
2954		3152
2955	$self->{item}{$widget} = $item;	3153	$self->{item}{$widget} = $item;
2956		3154
2957	$self->{vbox}->add ($widget);	3155	$self->{vbox}->add ($widget);
…		…
2962		3160
2963	# popup given the event (must be a mouse button down event currently)	3161	# popup given the event (must be a mouse button down event currently)
2964	sub popup {	3162	sub popup {
2965	my ($self, $ev) = @_;	3163	my ($self, $ev) = @_;
2966		3164
2967	$self->_emit ("popdown");	3165	$self->emit ("popdown");
2968		3166
2969	# maybe save $GRAB? must be careful about events...	3167	# maybe save $GRAB? must be careful about events...
2970	$GRAB = $self;	3168	$GRAB = $self;
2971	$self->{button} = $ev->{button};	3169	$self->{button} = $ev->{button};
2972		3170
2973	$self->show;	3171	$self->show;
2974	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3172	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2975	}	3173	}
2976		3174
2977	sub mouse_motion {	3175	sub invoke_mouse_motion {
2978	my ($self, $ev, $x, $y) = @_;	3176	my ($self, $ev, $x, $y) = @_;
2979		3177
2980	# TODO: should use vbox->find_widget or so	3178	# TODO: should use vbox->find_widget or so
2981	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3179	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2982	$self->{hover} = $self->{item}{$HOVER};	3180	$self->{hover} = $self->{item}{$HOVER};
2983		3181
2984	0	3182	0
2985	}	3183	}
2986		3184
2987	sub button_up {	3185	sub invoke_button_up {
2988	my ($self, $ev, $x, $y) = @_;	3186	my ($self, $ev, $x, $y) = @_;
2989		3187
2990	if ($ev->{button} == $self->{button}) {	3188	if ($ev->{button} == $self->{button}) {
2991	undef $GRAB;	3189	undef $GRAB;
2992	$self->hide;	3190	$self->hide;
2993		3191
2994	$self->_emit ("popdown");	3192	$self->emit ("popdown");
2995	$self->{hover}[1]->() if $self->{hover};	3193	$self->{hover}[1]->() if $self->{hover};
2996	} else {	3194	} else {
2997	return 0	3195	return 0
2998	}	3196	}
2999		3197
…		…
3026		3224
3027	$self->{current} = $self->{children}[0]	3225	$self->{current} = $self->{children}[0]
3028	if @{ $self->{children} };	3226	if @{ $self->{children} };
3029	}	3227	}
3030		3228
		3229	sub get_current_page {
		3230	my ($self) = @_;
		3231
		3232	$self->{current}
		3233	}
		3234
3031	sub set_current_page {	3235	sub set_current_page {
3032	my ($self, $page_or_widget) = @_;	3236	my ($self, $page_or_widget) = @_;
3033		3237
3034	my $widget = ref $page_or_widget	3238	my $widget = ref $page_or_widget
3035	? $page_or_widget	3239	? $page_or_widget
3036	: $self->{children}[$page_or_widget];	3240	: $self->{children}[$page_or_widget];
3037		3241
3038	$self->{current} = $widget;	3242	$self->{current} = $widget;
3039	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3243	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3040		3244
3041	$self->_emit (page_changed => $self->{current});	3245	$self->emit (page_changed => $self->{current});
3042		3246
3043	$self->realloc;	3247	$self->realloc;
3044	}	3248	}
3045		3249
3046	sub visible_children {	3250	sub visible_children {
…		…
3051	my ($self) = @_;	3255	my ($self) = @_;
3052		3256
3053	$self->{current}->size_request	3257	$self->{current}->size_request
3054	}	3258	}
3055		3259
3056	sub size_allocate {	3260	sub invoke_size_allocate {
3057	my ($self, $w, $h) = @_;	3261	my ($self, $w, $h) = @_;
3058		3262
3059	$self->{current}->configure (0, 0, $w, $h);	3263	$self->{current}->configure (0, 0, $w, $h);
		3264
		3265	1
3060	}	3266	}
3061		3267
3062	sub _draw {	3268	sub _draw {
3063	my ($self) = @_;	3269	my ($self) = @_;
3064		3270
…		…
3099	);	3305	);
3100		3306
3101	$self->{multiplexer}->add ($widget);	3307	$self->{multiplexer}->add ($widget);
3102	}	3308	}
3103		3309
		3310	sub get_current_page {
		3311	my ($self) = @_;
		3312
		3313	$self->{multiplexer}->get_current_page
		3314	}
		3315
3104	sub set_current_page {	3316	sub set_current_page {
3105	my ($self, $page) = @_;	3317	my ($self, $page) = @_;
3106		3318
3107	$self->{multiplexer}->set_current_page ($page);	3319	$self->{multiplexer}->set_current_page ($page);
3108	$self->_emit (page_changed => $self->{multiplexer}{current});	3320	$self->emit (page_changed => $self->{multiplexer}{current});
3109	}	3321	}
3110		3322
3111	#############################################################################	3323	#############################################################################
3112		3324
3113	package CFClient::UI::Combobox;	3325	package CFClient::UI::Combobox;
…		…
3128	$self->_set_value ($self->{value});	3340	$self->_set_value ($self->{value});
3129		3341
3130	$self	3342	$self
3131	}	3343	}
3132		3344
3133	sub button_down {	3345	sub invoke_button_down {
3134	my ($self, $ev) = @_;	3346	my ($self, $ev) = @_;
3135		3347
3136	my @menu_items;	3348	my @menu_items;
3137		3349
3138	for (@{ $self->{options} }) {	3350	for (@{ $self->{options} }) {
…		…
3159	my ($self, $value) = @_;	3371	my ($self, $value) = @_;
3160		3372
3161	return unless $self->{value} ne $value;	3373	return unless $self->{value} ne $value;
3162		3374
3163	$self->_set_value ($value);	3375	$self->_set_value ($value);
3164	$self->_emit (changed => $value);	3376	$self->emit (changed => $value);
3165	}	3377	}
3166		3378
3167	#############################################################################	3379	#############################################################################
3168		3380
3169	package CFClient::UI::Statusbox;	3381	package CFClient::UI::Statusbox;
…		…
3284	count => 1,	3496	count => 1,
3285	%arg,	3497	%arg,
3286	};	3498	};
3287	}	3499	}
3288		3500
		3501	$ROOT->on_refresh (reorder => sub {
3289	$self->reorder;	3502	$self->reorder;
		3503	});
3290	}	3504	}
3291		3505
3292	sub reconfigure {	3506	sub reconfigure {
3293	my ($self) = @_;	3507	my ($self) = @_;
3294		3508
…		…
3309		3523
3310	#############################################################################	3524	#############################################################################
3311		3525
3312	package CFClient::UI::Inventory;	3526	package CFClient::UI::Inventory;
3313		3527
3314	our @ISA = CFClient::UI::ScrolledWindow::;	3528	our @ISA = CFClient::UI::Table::;
3315		3529
3316	sub new {	3530	sub new {
3317	my $class = shift;	3531	my $class = shift;
3318		3532
3319	my $self = $class->SUPER::new (	3533	my $self = $class->SUPER::new (
3320	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),	3534	col_expand => [0, 1, 0],
3321	@_,	3535	@_,
3322	);	3536	);
3323		3537
3324	$self	3538	$self
3325	}	3539	}
3326		3540
3327	sub set_items {	3541	sub set_items {
3328	my ($self, $items) = @_;	3542	my ($self, $items) = @_;
3329		3543
3330	$self->{child}->clear;	3544	$self->clear;
3331	return unless $items;	3545	return unless $items;
3332		3546
3333	my @items = sort {	3547	my @items = sort {
3334	($a->{type} <=> $b->{type})	3548	($a->{type} <=> $b->{type})
3335	or ($a->{name} cmp $b->{name})	3549	or ($a->{name} cmp $b->{name})
3336	} @$items;	3550	} values %$items;
3337		3551
3338	$self->{real_items} = \@items;	3552	$self->{real_items} = \@items;
3339		3553
3340	my $row = 0;	3554	my $row = 0;
3341	for my $item (@items) {	3555	for my $item (@items) {
3342	CFClient::Item::update_widgets $item;	3556	CFClient::Item::update_widgets $item;
3343		3557
3344	$self->{child}->add (0, $row, $item->{face_widget});	3558	$self->add (0, $row, $item->{face_widget});
3345	$self->{child}->add (1, $row, $item->{desc_widget});	3559	$self->add (1, $row, $item->{desc_widget});
3346	$self->{child}->add (2, $row, $item->{weight_widget});	3560	$self->add (2, $row, $item->{weight_widget});
3347		3561
3348	$row++;	3562	$row++;
3349	}
3350	}
3351
3352	#############################################################################
3353
3354	package CFClient::UI::BindEditor;
3355
3356	our @ISA = CFClient::UI::FancyFrame::;
3357
3358	sub new {
3359	my $class = shift;
3360
3361	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3362
3363	$self->add (my $vb = new CFClient::UI::VBox);
3364
3365
3366	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3367	text => "start recording",
3368	tooltip => "Start/Stops recording of actions."
3369	."All subsequent actions after the recording started will be captured."
3370	."The actions are displayed after the record was stopped."
3371	."To bind the action you have to click on the 'Bind' button",
3372	on_activate => sub {
3373	unless ($self->{recording}) {
3374	$self->start;
3375	} else {
3376	$self->stop;
3377	}
3378	});
3379
3380	$vb->add (new CFClient::UI::Label text => "Actions:");
3381	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3382
3383	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3384	$vb->add (my $hb = new CFClient::UI::HBox);
3385	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3386	$hb->add (new CFClient::UI::Button
3387	text => "bind",
3388	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3389	on_activate => sub {
3390	$self->ask_for_bind;
3391	});
3392
3393	$vb->add (my $hb = new CFClient::UI::HBox);
3394	$hb->add (new CFClient::UI::Button
3395	text => "ok",
3396	expand => 1,
3397	tooltip => "This closes the binding editor and saves the binding",
3398	on_activate => sub {
3399	$self->hide;
3400	$self->commit;
3401	});
3402
3403	$hb->add (new CFClient::UI::Button
3404	text => "cancel",
3405	expand => 1,
3406	tooltip => "This closes the binding editor without saving",
3407	on_activate => sub {
3408	$self->hide;
3409	$self->{binding_cancel}->()
3410	if $self->{binding_cancel};
3411	});
3412
3413	$self->update_binding_widgets;
3414
3415	$self
3416	}
3417
3418	sub commit {
3419	my ($self) = @_;
3420	my ($mod, $sym, $cmds) = $self->get_binding;
3421	if ($sym != 0 && @$cmds > 0) {
3422	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3423	."'. Don't forget 'Save Config'!");
3424	$self->{binding_change}->($mod, $sym, $cmds)
3425	if $self->{binding_change};
3426	} else {
3427	$::STATUSBOX->add ("No action bound, no key or action specified!");
3428	$self->{binding_cancel}->()
3429	if $self->{binding_cancel};
3430	}
3431	}
3432
3433	sub start {
3434	my ($self) = @_;
3435
3436	$self->{rec_btn}->set_text ("stop recording");
3437	$self->{recording} = 1;
3438	$self->clear_command_list;
3439	$::CONN->start_record if $::CONN;
3440	}
3441
3442	sub stop {
3443	my ($self) = @_;
3444
3445	$self->{rec_btn}->set_text ("start recording");
3446	$self->{recording} = 0;
3447
3448	my $rec;
3449	$rec = $::CONN->stop_record if $::CONN;
3450	return unless ref $rec eq 'ARRAY';
3451	$self->set_command_list ($rec);
3452	}
3453
3454
3455	sub ask_for_bind_and_commit {
3456	my ($self) = @_;
3457	$self->ask_for_bind (1);
3458	}
3459
3460	sub ask_for_bind {
3461	my ($self, $commit) = @_;
3462
3463	CFClient::Binder::open_binding_dialog (sub {
3464	my ($mod, $sym) = @_;
3465	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3466	$self->update_binding_widgets;
3467	$self->commit if $commit;
3468	});
3469	}
3470
3471	# $mod and $sym are the modifiers and key symbol
3472	# $cmds is a array ref of strings (the commands)
3473	# $cb is the callback that is executed on OK
3474	# $ccb is the callback that is executed on CANCEL and
3475	# when the binding was unsuccessful on OK
3476	sub set_binding {
3477	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3478
3479	$self->clear_command_list;
3480	$self->{recording} = 0;
3481	$self->{rec_btn}->set_text ("start recording");
3482
3483	$self->{binding} = [$mod, $sym];
3484	$self->{commands} = $cmds;
3485
3486	$self->{binding_change} = $cb;
3487	$self->{binding_cancel} = $ccb;
3488
3489	$self->update_binding_widgets;
3490	}
3491
3492	# this is a shortcut method that asks for a binding
3493	# and then just binds it.
3494	sub do_quick_binding {
3495	my ($self, $cmds) = @_;
3496	$self->set_binding (undef, undef, $cmds, sub {
3497	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3498	});
3499	$self->ask_for_bind (1);
3500	}
3501
3502	sub update_binding_widgets {
3503	my ($self) = @_;
3504	my ($mod, $sym, $cmds) = $self->get_binding;
3505	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3506	$self->set_command_list ($cmds);
3507	}
3508
3509	sub get_binding {
3510	my ($self) = @_;
3511	return (
3512	$self->{binding}->[0],
3513	$self->{binding}->[1],
3514	[ grep { defined $_ } @{$self->{commands}} ]
3515	);
3516	}
3517
3518	sub clear_command_list {
3519	my ($self) = @_;
3520	$self->{cmdbox}->clear ();
3521	}
3522
3523	sub set_command_list {
3524	my ($self, $cmds) = @_;
3525
3526	$self->{cmdbox}->clear ();
3527	$self->{commands} = $cmds;
3528
3529	my $idx = 0;
3530
3531	for (@$cmds) {
3532	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3533
3534	my $i = $idx;
3535	$hb->add (new CFClient::UI::Label text => $_);
3536	$hb->add (new CFClient::UI::Button
3537	text => "delete",
3538	tooltip => "Deletes the action from the record",
3539	on_activate => sub {
3540	$self->{cmdbox}->remove ($hb);
3541	$cmds->[$i] = undef;
3542	});
3543
3544
3545	$idx++
3546	}	3563	}
3547	}	3564	}
3548		3565
3549	#############################################################################	3566	#############################################################################
3550		3567
…		…
3604	} elsif ($ev->{button} == 2) {	3621	} elsif ($ev->{button} == 2) {
3605	$::CONN->user_send ("invoke $spell->{name}");	3622	$::CONN->user_send ("invoke $spell->{name}");
3606	} elsif ($ev->{button} == 3) {	3623	} elsif ($ev->{button} == 3) {
3607	(new CFClient::UI::Menu	3624	(new CFClient::UI::Menu
3608	items => [	3625	items => [
3609	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],	3626	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3610	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],	3627	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3611	],	3628	],
3612	)->popup ($ev);	3629	)->popup ($ev);
3613	} else {	3630	} else {
3614	return 0;	3631	return 0;
…		…
3709	$coord = $max - $size if $coord > $max - $size;	3726	$coord = $max - $size if $coord > $max - $size;
3710		3727
3711	int $coord + 0.5	3728	int $coord + 0.5
3712	}	3729	}
3713		3730
3714	sub size_allocate {	3731	sub invoke_size_allocate {
3715	my ($self, $w, $h) = @_;	3732	my ($self, $w, $h) = @_;
3716		3733
3717	for my $child ($self->children) {	3734	for my $child ($self->children) {
3718	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3735	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3719		3736
…		…
3723	$X = _to_pixel $X, $W, $self->{w};	3740	$X = _to_pixel $X, $W, $self->{w};
3724	$Y = _to_pixel $Y, $H, $self->{h};	3741	$Y = _to_pixel $Y, $H, $self->{h};
3725		3742
3726	$child->configure ($X, $Y, $W, $H);	3743	$child->configure ($X, $Y, $W, $H);
3727	}	3744	}
		3745
		3746	1
3728	}	3747	}
3729		3748
3730	sub coord2local {	3749	sub coord2local {
3731	my ($self, $x, $y) = @_;	3750	my ($self, $x, $y) = @_;
3732		3751
…		…
3858	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3877	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3859		3878
3860	$w = 0 if $w < 0;	3879	$w = 0 if $w < 0;
3861	$h = 0 if $h < 0;	3880	$h = 0 if $h < 0;
3862		3881
		3882	$w = max $widget->{min_w}, $w;
		3883	$h = max $widget->{min_h}, $h;
		3884
		3885	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3886	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3887
3863	$w = int $w + 0.5;	3888	$w = int $w + 0.5;
3864	$h = int $h + 0.5;	3889	$h = int $h + 0.5;
3865		3890
3866	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	3891	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3867	$widget->{old_w} = $widget->{w};	3892	$widget->{old_w} = $widget->{w};

Diff Legend

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