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.304 by elmex, Tue Jun 13 11:01:04 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
1095	unless ($self->{no_close_button}) {	1140	if ($self->{has_close_button}) {
1096	$self->{close_btn} =	1141	$self->{close_button} =
1097	new CFClient::UI::ImageButton	1142	new CFClient::UI::ImageButton
1098	image => 'x1_close.png',	1143	path => 'x1_close.png',
1099	on_activate => sub { $self->hide };	1144	on_activate => sub { $self->emit ("delete") };
1100		1145
1101	$self->CFClient::UI::Container::add ($self->{close_btn});	1146	$self->CFClient::UI::Container::add ($self->{close_button});
1102	}	1147	}
1103		1148
1104	$self	1149	$self
1105	}	1150	}
1106		1151
1107	sub add {	1152	sub add {
1108	my ($self, @widgets) = @_;	1153	my ($self, @widgets) = @_;
1109		1154
1110	$self->SUPER::add (@widgets);	1155	$self->SUPER::add (@widgets);
1111	$self->CFClient::UI::Container::add ($self->{close_btn}) if $self->{close_btn};	1156	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1112	$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};
1113	}	1158	}
1114		1159
1115	sub border {	1160	sub border {
1116	int $_[0]{border} * $::FONTSIZE	1161	int $_[0]{border} * $::FONTSIZE
…		…
1120	my ($self) = @_;	1165	my ($self) = @_;
1121		1166
1122	$self->{title_widget}->size_request	1167	$self->{title_widget}->size_request
1123	if $self->{title_widget};	1168	if $self->{title_widget};
1124		1169
1125	$self->{close_btn}->size_request	1170	$self->{close_button}->size_request
1126	if $self->{close_btn};	1171	if $self->{close_button};
1127		1172
1128	my ($w, $h) = $self->SUPER::size_request;	1173	my ($w, $h) = $self->SUPER::size_request;
1129		1174
1130	(	1175	(
1131	$w + $self->border * 2,	1176	$w + $self->border * 2,
1132	$h + $self->border * 2,	1177	$h + $self->border * 2,
1133	)	1178	)
1134	}	1179	}
1135		1180
1136	sub size_allocate {	1181	sub invoke_size_allocate {
1137	my ($self, $w, $h) = @_;	1182	my ($self, $w, $h) = @_;
1138		1183
1139	if ($self->{title_widget}) {	1184	if ($self->{title_widget}) {
1140	$self->{title_widget}{w} = $w;	1185	$self->{title_widget}{w} = $w;
1141	$self->{title_widget}{h} = $h;	1186	$self->{title_widget}{h} = $h;
1142	$self->{title_widget}->size_allocate ($w, $h);	1187	$self->{title_widget}->invoke_size_allocate ($w, $h);
1143	}	1188	}
1144		1189
1145	my $border = $self->border;	1190	my $border = $self->border;
1146		1191
1147	$h -= List::Util::max 0, $border * 2;	1192	$h -= List::Util::max 0, $border * 2;
1148	$w -= List::Util::max 0, $border * 2;	1193	$w -= List::Util::max 0, $border * 2;
1149		1194
1150	$self->child->configure ($border, $border, $w, $h);	1195	$self->child->configure ($border, $border, $w, $h);
1151		1196
1152	$self->{close_btn}->configure ($self->{w} - (2 * $border), 0, $border, $border)	1197	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1153	if $self->{close_btn};	1198	if $self->{close_button};
1154	}
1155		1199
		1200	1
		1201	}
		1202
		1203	sub invoke_delete {
		1204	my ($self) = @_;
		1205
		1206	$self->hide;
		1207
		1208	1
		1209	}
		1210
1156	sub button_down {	1211	sub invoke_button_down {
1157	my ($self, $ev, $x, $y) = @_;	1212	my ($self, $ev, $x, $y) = @_;
1158		1213
1159	my ($w, $h) = @$self{qw(w h)};	1214	my ($w, $h) = @$self{qw(w h)};
1160	my $border = $self->border;	1215	my $border = $self->border;
1161		1216
…		…
1192		1247
1193	($x, $y) = ($ev->{x}, $ev->{y});	1248	($x, $y) = ($ev->{x}, $ev->{y});
1194		1249
1195	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1250	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1196	# HACK: the next line is required to enforce placement	1251	# HACK: the next line is required to enforce placement
1197	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1252	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1198	};	1253	};
1199	} else {	1254	} else {
1200	return 0;	1255	return 0;
1201	}	1256	}
1202		1257
1203	1	1258	1
1204	}	1259	}
1205		1260
1206	sub button_up {	1261	sub invoke_button_up {
1207	my ($self, $ev, $x, $y) = @_;	1262	my ($self, $ev, $x, $y) = @_;
1208		1263
1209	$self->{close_btn}->button_up ($ev, $x, $y)
1210	if $self->{close_btn};
1211
1212	!!delete $self->{motion}	1264	! ! delete $self->{motion}
1213	}	1265	}
1214		1266
1215	sub mouse_motion {	1267	sub invoke_mouse_motion {
1216	my ($self, $ev, $x, $y) = @_;	1268	my ($self, $ev, $x, $y) = @_;
1217		1269
1218	$self->{motion}->($ev, $x, $y) if $self->{motion};	1270	$self->{motion}->($ev, $x, $y) if $self->{motion};
1219		1271
1220	!!$self->{motion}	1272	! ! $self->{motion}
1221	}	1273	}
1222		1274
1223	sub _draw {	1275	sub _draw {
1224	my ($self) = @_;	1276	my ($self) = @_;
1225		1277
…		…
1258	$self->{title_widget}->_draw;	1310	$self->{title_widget}->_draw;
1259		1311
1260	glTranslate 0, - ($border - $self->{h});	1312	glTranslate 0, - ($border - $self->{h});
1261	}	1313	}
1262		1314
1263	$self->{close_btn}->draw	1315	$self->{close_button}->draw
1264	if $self->{close_btn};	1316	if $self->{close_button};
1265	}	1317	}
1266		1318
1267	#############################################################################	1319	#############################################################################
1268		1320
1269	package CFClient::UI::Table;	1321	package CFClient::UI::Table;
…		…
1348	(sum @$ws),	1400	(sum @$ws),
1349	(sum @$hs),	1401	(sum @$hs),
1350	)	1402	)
1351	}	1403	}
1352		1404
1353	sub size_allocate {	1405	sub invoke_size_allocate {
1354	my ($self, $w, $h) = @_;	1406	my ($self, $w, $h) = @_;
1355		1407
1356	my ($ws, $hs) = $self->get_wh;	1408	my ($ws, $hs) = $self->get_wh;
1357		1409
1358	my $req_w = (sum @$ws) || 1;	1410	my $req_w = (sum @$ws) || 1;
…		…
1390	}	1442	}
1391		1443
1392	$y += $row_h;	1444	$y += $row_h;
1393	}	1445	}
1394		1446
		1447	1
1395	}	1448	}
1396		1449
1397	sub find_widget {	1450	sub find_widget {
1398	my ($self, $x, $y) = @_;	1451	my ($self, $x, $y) = @_;
1399		1452
…		…
1436	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1489	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1437	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1490	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1438	)	1491	)
1439	}	1492	}
1440		1493
1441	sub size_allocate {	1494	sub invoke_size_allocate {
1442	my ($self, $w, $h) = @_;	1495	my ($self, $w, $h) = @_;
1443		1496
1444	my $space = $self->{vertical} ? $h : $w;	1497	my $space = $self->{vertical} ? $h : $w;
1445	my $children = $self->{children};	1498	my @children = $self->visible_children;
1446		1499
1447	my @req;	1500	my @req;
1448		1501
1449	if ($self->{homogeneous}) {	1502	if ($self->{homogeneous}) {
1450	@req = ($space / (@$children || 1)) x @$children;	1503	@req = ($space / (@children || 1)) x @children;
1451	} else {	1504	} else {
1452	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1505	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1453	my $req = List::Util::sum @req;	1506	my $req = List::Util::sum @req;
1454		1507
1455	if ($req > $space) {	1508	if ($req > $space) {
1456	# ah well, not enough space	1509	# ah well, not enough space
1457	$_ *= $space / $req for @req;	1510	$_ *= $space / $req for @req;
1458	} else {	1511	} else {
1459	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1512	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1460		1513
1461	$space = ($space - $req) / $expand; # remaining space to give away	1514	$space = ($space - $req) / $expand; # remaining space to give away
1462		1515
1463	$req[$_] += $space * $children->[$_]{expand}	1516	$req[$_] += $space * $children[$_]{expand}
1464	for 0 .. $#$children;	1517	for 0 .. $#children;
1465	}	1518	}
1466	}	1519	}
1467		1520
1468	CFClient::UI::harmonize \@req;	1521	CFClient::UI::harmonize \@req;
1469		1522
1470	my $pos = 0;	1523	my $pos = 0;
1471	for (0 .. $#$children) {	1524	for (0 .. $#children) {
1472	my $alloc = $req[$_];	1525	my $alloc = $req[$_];
1473	$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));
1474		1527
1475	$pos += $alloc;	1528	$pos += $alloc;
1476	}	1529	}
1477		1530
1478	1	1531	1
…		…
1581	my ($self, $text) = @_;	1634	my ($self, $text) = @_;
1582		1635
1583	return if $self->{text} eq "T$text";	1636	return if $self->{text} eq "T$text";
1584	$self->{text} = "T$text";	1637	$self->{text} = "T$text";
1585		1638
1586	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1587	$self->{layout}->set_text ($text);	1639	$self->{layout}->set_text ($text);
1588		1640
1589	delete $self->{size_req};	1641	delete $self->{size_req};
1590	$self->realloc;	1642	$self->realloc;
1591	$self->update;	1643	$self->update;
…		…
1597	return if $self->{text} eq "M$markup";	1649	return if $self->{text} eq "M$markup";
1598	$self->{text} = "M$markup";	1650	$self->{text} = "M$markup";
1599		1651
1600	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1652	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1601		1653
1602	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1603	$self->{layout}->set_markup ($markup);	1654	$self->{layout}->set_markup ($markup);
1604		1655
1605	delete $self->{size_req};	1656	delete $self->{size_req};
1606	$self->realloc;	1657	$self->realloc;
1607	$self->update;	1658	$self->update;
…		…
1619		1670
1620	my ($w, $h) = $self->{layout}->size;	1671	my ($w, $h) = $self->{layout}->size;
1621		1672
1622	if (exists $self->{template}) {	1673	if (exists $self->{template}) {
1623	$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);
1624	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1676	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1625		1677
1626	my ($w2, $h2) = $self->{template}->size;	1678	my ($w2, $h2) = $self->{template}->size;
1627		1679
1628	$w = List::Util::max $w, $w2;	1680	$w = List::Util::max $w, $w2;
…		…
1633	};	1685	};
1634		1686
1635	@{ $self->{size_req} }	1687	@{ $self->{size_req} }
1636	}	1688	}
1637		1689
		1690	sub baseline_shift {
		1691	$_[0]{layout}->descent
		1692	}
		1693
1638	sub size_allocate {	1694	sub invoke_size_allocate {
1639	my ($self, $w, $h) = @_;	1695	my ($self, $w, $h) = @_;
1640		1696
1641	delete $self->{ox};	1697	delete $self->{ox};
1642		1698
1643	delete $self->{texture}	1699	delete $self->{texture}
1644	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
1645	}	1703	}
1646		1704
1647	sub set_fontsize {	1705	sub set_fontsize {
1648	my ($self, $fontsize) = @_;	1706	my ($self, $fontsize) = @_;
1649		1707
1650	$self->{fontsize} = $fontsize;	1708	$self->{fontsize} = $fontsize;
		1709	delete $self->{size_req};
1651	delete $self->{texture};	1710	delete $self->{texture};
1652		1711
1653	$self->realloc;	1712	$self->realloc;
1654	}	1713	}
1655		1714
1656	sub reconfigure {	1715	sub reconfigure {
1657	my ($self) = @_;	1716	my ($self) = @_;
1658		1717
1659	delete $self->{size_req};	1718	delete $self->{size_req};
		1719	delete $self->{texture};
1660		1720
1661	$self->SUPER::reconfigure;	1721	$self->SUPER::reconfigure;
1662	}	1722	}
1663		1723
1664	sub _draw {	1724	sub _draw {
1665	my ($self) = @_;	1725	my ($self) = @_;
1666		1726
1667	$self->SUPER::_draw; # draw background, if applicable	1727	$self->SUPER::_draw; # draw background, if applicable
1668		1728
1669	my $tex = $self->{texture} ||= do {	1729	my $size = $self->{texture} ||= do {
1670	$self->{layout}->set_foreground (@{$self->{fg}});	1730	$self->{layout}->set_foreground (@{$self->{fg}});
1671	$self->{layout}->set_font ($self->{font}) if $self->{font};	1731	$self->{layout}->set_font ($self->{font}) if $self->{font};
1672	$self->{layout}->set_width ($self->{w});	1732	$self->{layout}->set_width ($self->{w});
1673	$self->{layout}->set_ellipsise ($self->{ellipsise});	1733	$self->{layout}->set_ellipsise ($self->{ellipsise});
1674	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1734	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1675	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1735	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1676		1736
1677	new_from_layout CFClient::Texture $self->{layout}	1737	[$self->{layout}->size]
1678	};	1738	};
1679		1739
1680	unless (exists $self->{ox}) {	1740	unless (exists $self->{ox}) {
1681	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1741	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1682	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1742	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1683	: ($self->{w} - $tex->{w}) * 0.5);	1743	: ($self->{w} - $size->[0]) * 0.5);
1684		1744
1685	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1745	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1686	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1746	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1687	: ($self->{h} - $tex->{h}) * 0.5);	1747	: ($self->{h} - $size->[1]) * 0.5);
1688	};	1748	};
1689		1749
1690	glEnable GL_TEXTURE_2D;
1691
1692	my $w = List::Util::min $self->{w} + 4, $tex->{w};	1750	my $w = List::Util::min $self->{w} + 4, $size->[0];
1693	my $h = List::Util::min $self->{h} + 2, $tex->{h};	1751	my $h = List::Util::min $self->{h} + 2, $size->[1];
1694		1752
1695	if ($tex->{format} == GL_ALPHA) {	1753	$self->{layout}->render ($self->{ox}, $self->{oy});
1696	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1697	glColor @{$self->{fg}};
1698	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1699	} else {
1700	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1701	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1702	}
1703
1704	glDisable GL_TEXTURE_2D;
1705	}	1754	}
1706		1755
1707	#############################################################################	1756	#############################################################################
1708		1757
1709	package CFClient::UI::EntryBase;	1758	package CFClient::UI::EntryBase;
…		…
1742		1791
1743	$text =~ s/./*/g if $self->{hidden};	1792	$text =~ s/./*/g if $self->{hidden};
1744	$self->{layout}->set_text ("$text ");	1793	$self->{layout}->set_text ("$text ");
1745	delete $self->{size_req};	1794	delete $self->{size_req};
1746		1795
1747	$self->_emit (changed => $self->{text});	1796	$self->emit (changed => $self->{text});
1748		1797
1749	$self->realloc;	1798	$self->realloc;
1750	$self->update;	1799	$self->update;
1751	}	1800	}
1752		1801
…		…
1767	my ($w, $h) = $self->SUPER::size_request;	1816	my ($w, $h) = $self->SUPER::size_request;
1768		1817
1769	($w + 1, $h) # add 1 for cursor	1818	($w + 1, $h) # add 1 for cursor
1770	}	1819	}
1771		1820
1772	sub key_down {	1821	sub invoke_key_down {
1773	my ($self, $ev) = @_;	1822	my ($self, $ev) = @_;
1774		1823
1775	my $mod = $ev->{mod};	1824	my $mod = $ev->{mod};
1776	my $sym = $ev->{sym};	1825	my $sym = $ev->{sym};
1777	my $uni = $ev->{unicode};	1826	my $uni = $ev->{unicode};
…		…
1789	} elsif ($sym == CFClient::SDLK_HOME) {	1838	} elsif ($sym == CFClient::SDLK_HOME) {
1790	$self->{cursor} = 0;	1839	$self->{cursor} = 0;
1791	} elsif ($sym == CFClient::SDLK_END) {	1840	} elsif ($sym == CFClient::SDLK_END) {
1792	$self->{cursor} = length $text;	1841	$self->{cursor} = length $text;
1793	} elsif ($uni == 27) {	1842	} elsif ($uni == 27) {
1794	$self->_emit ('escape');	1843	$self->emit ('escape');
1795	} elsif ($uni) {	1844	} elsif ($uni) {
1796	substr $text, $self->{cursor}++, 0, chr $uni;	1845	substr $text, $self->{cursor}++, 0, chr $uni;
1797	} else {	1846	} else {
1798	return 0;	1847	return 0;
1799	}	1848	}
…		…
1803	$self->realloc;	1852	$self->realloc;
1804		1853
1805	1	1854	1
1806	}	1855	}
1807		1856
1808	sub focus_in {	1857	sub invoke_focus_in {
1809	my ($self) = @_;	1858	my ($self) = @_;
1810		1859
1811	$self->{last_activity} = $::NOW;	1860	$self->{last_activity} = $::NOW;
1812		1861
1813	$self->SUPER::focus_in;	1862	$self->SUPER::invoke_focus_in
1814	}	1863	}
1815		1864
1816	sub button_down {	1865	sub invoke_button_down {
1817	my ($self, $ev, $x, $y) = @_;	1866	my ($self, $ev, $x, $y) = @_;
1818		1867
1819	$self->SUPER::button_down ($ev, $x, $y);	1868	$self->SUPER::invoke_button_down ($ev, $x, $y);
1820		1869
1821	my $idx = $self->{layout}->xy_to_index ($x, $y);	1870	my $idx = $self->{layout}->xy_to_index ($x, $y);
1822		1871
1823	# byte-index to char-index	1872	# byte-index to char-index
1824	my $text = $self->{text};	1873	my $text = $self->{text};
1825	utf8::encode $text;	1874	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1826	$self->{cursor} = length substr $text, 0, $idx;	1875	$self->{cursor} = length $text;
1827		1876
1828	$self->_set_text ($self->{text});	1877	$self->_set_text ($self->{text});
1829	$self->update;	1878	$self->update;
1830		1879
1831	1	1880	1
1832	}	1881	}
1833		1882
1834	sub mouse_motion {	1883	sub invoke_mouse_motion {
1835	my ($self, $ev, $x, $y) = @_;	1884	my ($self, $ev, $x, $y) = @_;
1836	# 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#
1837		1886
1838	0	1887	1
1839	}	1888	}
1840		1889
1841	sub _draw {	1890	sub _draw {
1842	my ($self) = @_;	1891	my ($self) = @_;
1843		1892
…		…
1884		1933
1885	our @ISA = CFClient::UI::EntryBase::;	1934	our @ISA = CFClient::UI::EntryBase::;
1886		1935
1887	use CFClient::OpenGL;	1936	use CFClient::OpenGL;
1888		1937
1889	sub key_down {	1938	sub invoke_key_down {
1890	my ($self, $ev) = @_;	1939	my ($self, $ev) = @_;
1891		1940
1892	my $sym = $ev->{sym};	1941	my $sym = $ev->{sym};
1893		1942
1894	if ($sym == 13) {	1943	if ($sym == 13) {
1895	unshift @{$self->{history}},	1944	unshift @{$self->{history}},
1896	my $txt = $self->get_text;	1945	my $txt = $self->get_text;
		1946
1897	$self->{history_pointer} = -1;	1947	$self->{history_pointer} = -1;
1898	$self->{history_saveback} = '';	1948	$self->{history_saveback} = '';
1899	$self->_emit (activate => $txt);	1949	$self->emit (activate => $txt);
1900	$self->update;	1950	$self->update;
1901		1951
1902	} elsif ($sym == CFClient::SDLK_UP) {	1952	} elsif ($sym == CFClient::SDLK_UP) {
1903	if ($self->{history_pointer} < 0) {	1953	if ($self->{history_pointer} < 0) {
1904	$self->{history_saveback} = $self->get_text;	1954	$self->{history_saveback} = $self->get_text;
…		…
1920	} else {	1970	} else {
1921	$self->set_text ($self->{history_saveback});	1971	$self->set_text ($self->{history_saveback});
1922	}	1972	}
1923		1973
1924	} else {	1974	} else {
1925	return $self->SUPER::key_down ($ev)	1975	return $self->SUPER::invoke_key_down ($ev)
1926	}	1976	}
1927		1977
1928	1	1978	1
1929	}	1979	}
1930		1980
…		…
1954	can_events => 1,	2004	can_events => 1,
1955	@_	2005	@_
1956	)	2006	)
1957	}	2007	}
1958		2008
1959	sub activate { }
1960
1961	sub button_up {	2009	sub invoke_button_up {
1962	my ($self, $ev, $x, $y) = @_;	2010	my ($self, $ev, $x, $y) = @_;
1963		2011
1964	$self->emit ("activate")	2012	$self->emit ("activate")
1965	if $x >= 0 && $x < $self->{w}	2013	if $x >= 0 && $x < $self->{w}
1966	&& $y >= 0 && $y < $self->{h};	2014	&& $y >= 0 && $y < $self->{h};
…		…
2008	can_events => 1,	2056	can_events => 1,
2009	@_	2057	@_
2010	);	2058	);
2011	}	2059	}
2012		2060
2013	sub activate { }
2014
2015	sub button_up {	2061	sub invoke_button_up {
2016	my ($self, $ev, $x, $y) = @_;	2062	my ($self, $ev, $x, $y) = @_;
2017		2063
2018	$self->emit ("activate")	2064	$self->emit ("activate")
2019	if $x >= 0 && $x < $self->{w}	2065	if $x >= 0 && $x < $self->{w}
2020	&& $y >= 0 && $y < $self->{h};	2066	&& $y >= 0 && $y < $self->{h};
…		…
2054	my ($self) = @_;	2100	my ($self) = @_;
2055		2101
2056	(6) x 2	2102	(6) x 2
2057	}	2103	}
2058		2104
		2105	sub toggle {
		2106	my ($self) = @_;
		2107
		2108	$self->{state} = !$self->{state};
		2109	$self->emit (changed => $self->{state});
		2110	$self->update;
		2111	}
		2112
2059	sub button_down {	2113	sub invoke_button_down {
2060	my ($self, $ev, $x, $y) = @_;	2114	my ($self, $ev, $x, $y) = @_;
2061		2115
2062	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2116	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2063	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2117	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2064	$self->{state} = !$self->{state};	2118	$self->toggle;
2065	$self->_emit (changed => $self->{state});
2066	} else {	2119	} else {
2067	return 0	2120	return 0
2068	}	2121	}
2069		2122
2070	1	2123	1
…		…
2095	package CFClient::UI::Image;	2148	package CFClient::UI::Image;
2096		2149
2097	our @ISA = CFClient::UI::Base::;	2150	our @ISA = CFClient::UI::Base::;
2098		2151
2099	use CFClient::OpenGL;	2152	use CFClient::OpenGL;
2100	use Carp qw/confess/;
2101		2153
2102	our %loaded_images;	2154	our %texture_cache;
2103		2155
2104	sub new {	2156	sub new {
2105	my $class = shift;	2157	my $class = shift;
2106		2158
2107	my $self = $class->SUPER::new (can_events => 0, @_);	2159	my $self = $class->SUPER::new (
		2160	can_events => 0,
		2161	@_,
		2162	);
2108		2163
2109	$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";
2110		2166
2111	$loaded_images{$self->{image}} ||=	2167	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2112	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;
2113		2169
2114	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2170	Scalar::Util::weaken $texture_cache{$self->{path}};
2115		2171
2116	Scalar::Util::weaken $loaded_images{$self->{image}};	2172	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2117
2118	$self->{aspect} = $tex->{w} / $tex->{h};
2119		2173
2120	$self	2174	$self
2121	}	2175	}
2122		2176
2123	sub size_request {	2177	sub size_request {
2124	my ($self) = @_;	2178	my ($self) = @_;
2125		2179
2126	($self->{tex}->{w}, $self->{tex}->{h})	2180	($self->{tex}{w}, $self->{tex}{h})
2127	}	2181	}
2128		2182
2129	sub _draw {	2183	sub _draw {
2130	my ($self) = @_;	2184	my ($self) = @_;
2131		2185
…		…
2240	my $ycut1 = max 0, min 1, $ycut;	2294	my $ycut1 = max 0, min 1, $ycut;
2241	my $ycut2 = max 0, min 1, $ycut - 1;	2295	my $ycut2 = max 0, min 1, $ycut - 1;
2242		2296
2243	my $h1 = $self->{h} * (1 - $ycut1);	2297	my $h1 = $self->{h} * (1 - $ycut1);
2244	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);
2245		2302
2246	glEnable GL_BLEND;	2303	glEnable GL_BLEND;
2247	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2304	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2248	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2305	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2249	glEnable GL_TEXTURE_2D;	2306	glEnable GL_TEXTURE_2D;
…		…
2268		2325
2269	if ($t3) {	2326	if ($t3) {
2270	glBindTexture GL_TEXTURE_2D, $t3->{name};	2327	glBindTexture GL_TEXTURE_2D, $t3->{name};
2271	glBegin GL_QUADS;	2328	glBegin GL_QUADS;
2272	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2329	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2273	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2330	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2274	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2331	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2275	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2332	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2276	glEnd;	2333	glEnd;
2277	}	2334	}
2278		2335
2279	glDisable GL_BLEND;	2336	glDisable GL_BLEND;
…		…
2367	$self->update;	2424	$self->update;
2368		2425
2369	$self	2426	$self
2370	}	2427	}
2371		2428
2372	sub changed { }
2373
2374	sub set_range {	2429	sub set_range {
2375	my ($self, $range) = @_;	2430	my ($self, $range) = @_;
2376		2431
2377	($range, $self->{range}) = ($self->{range}, $range);	2432	($range, $self->{range}) = ($self->{range}, $range);
2378		2433
…		…
2398	if $unit;	2453	if $unit;
2399		2454
2400	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2455	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2401		2456
2402	if ($value != $old_value) {	2457	if ($value != $old_value) {
2403	$self->_emit (changed => $value);	2458	$self->emit (changed => $value);
2404	$self->update;	2459	$self->update;
2405	}	2460	}
2406	}	2461	}
2407		2462
2408	sub size_request {	2463	sub size_request {
2409	my ($self) = @_;	2464	my ($self) = @_;
2410		2465
2411	($self->{req_w}, $self->{req_h})	2466	($self->{req_w}, $self->{req_h})
2412	}	2467	}
2413		2468
2414	sub button_down {	2469	sub invoke_button_down {
2415	my ($self, $ev, $x, $y) = @_;	2470	my ($self, $ev, $x, $y) = @_;
2416		2471
2417	$self->SUPER::button_down ($ev, $x, $y);	2472	$self->SUPER::invoke_button_down ($ev, $x, $y);
2418		2473
2419	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2474	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2420		2475
2421	$self->mouse_motion ($ev, $x, $y)	2476	$self->invoke_mouse_motion ($ev, $x, $y)
2422	}	2477	}
2423		2478
2424	sub mouse_motion {	2479	sub invoke_mouse_motion {
2425	my ($self, $ev, $x, $y) = @_;	2480	my ($self, $ev, $x, $y) = @_;
2426		2481
2427	if ($GRAB == $self) {	2482	if ($GRAB == $self) {
2428	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2483	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2429		2484
…		…
2435	} else {	2490	} else {
2436	return 0;	2491	return 0;
2437	}	2492	}
2438		2493
2439	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
2440	}	2505	}
2441		2506
2442	sub update {	2507	sub update {
2443	my ($self) = @_;	2508	my ($self) = @_;
2444		2509
…		…
2545	sub new {	2610	sub new {
2546	my $class = shift;	2611	my $class = shift;
2547		2612
2548	my $self = $class->SUPER::new (	2613	my $self = $class->SUPER::new (
2549	fontsize => 1,	2614	fontsize => 1,
2550	can_events => 0,	2615	can_events => 1,
2551	indent => 0,	2616	indent => 0,
2552	#font => default_font	2617	#font => default_font
2553	@_,	2618	@_,
2554		2619
2555	layout => (new CFClient::Layout 1),	2620	layout => (new CFClient::Layout),
2556	par => [],	2621	par => [],
2557	height => 0,	2622	height => 0,
2558	children => [	2623	children => [
2559	(new CFClient::UI::Empty expand => 1),	2624	(new CFClient::UI::Empty expand => 1),
2560	(new CFClient::UI::Slider vertical => 1),	2625	(new CFClient::UI::Slider vertical => 1),
…		…
2571		2636
2572	$self->{fontsize} = $fontsize;	2637	$self->{fontsize} = $fontsize;
2573	$self->reflow;	2638	$self->reflow;
2574	}	2639	}
2575		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
2576	sub size_allocate {	2650	sub invoke_size_allocate {
2577	my ($self, $w, $h) = @_;	2651	my ($self, $w, $h) = @_;
2578		2652
2579	$self->SUPER::size_allocate ($w, $h);	2653	my ($empty, $slider, @other) = @{ $self->{children} };
		2654	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2580		2655
2581	$self->{layout}->set_font ($self->{font}) if $self->{font};	2656	$self->{layout}->set_font ($self->{font}) if $self->{font};
2582	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2657	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2583	$self->{layout}->set_width ($self->{children}[0]{w});	2658	$self->{layout}->set_width ($empty->{w});
2584	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2659	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2585		2660
2586	$self->reflow;	2661	$self->reflow;
2587	}
2588		2662
2589	sub text_size {	2663	local $self->{children} = [$empty, $slider];
		2664	$self->SUPER::invoke_size_allocate ($w, $h)
		2665	}
		2666
		2667	sub invoke_mouse_wheel {
2590	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) = @_;
2591		2679
2592	my $layout = $self->{layout};	2680	my $layout = $self->{layout};
2593		2681
		2682	$layout->set_font ($self->{font}) if $self->{font};
		2683	$layout->set_foreground (@{$para->{fg}});
2594	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2684	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2595	$layout->set_width ($self->{children}[0]{w} - $indent);	2685	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2596	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2686	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2597	$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}}
2598		2693	);
		2694
2599	$layout->size	2695	$layout
2600	}	2696	}
2601		2697
2602	sub reflow {	2698	sub reflow {
2603	my ($self) = @_;	2699	my ($self) = @_;
2604		2700
…		…
2613	$self->{children}[1]->set_value ($offset);	2709	$self->{children}[1]->set_value ($offset);
2614	}	2710	}
2615		2711
2616	sub clear {	2712	sub clear {
2617	my ($self) = @_;	2713	my ($self) = @_;
		2714
		2715	my (undef, undef, @other) = @{ $self->{children} };
		2716	$self->remove ($_) for @other;
2618		2717
2619	$self->{par} = [];	2718	$self->{par} = [];
2620	$self->{height} = 0;	2719	$self->{height} = 0;
2621	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2720	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2622	}	2721	}
2623		2722
2624	sub add_paragraph {	2723	sub add_paragraph {
2625	my ($self, $color, $text, $indent) = @_;	2724	my ($self, $color, $para, $indent) = @_;
2626		2725
2627	for my $line (split /\n/, $text) {	2726	my ($text, @w) = ref $para ? @$para : $para;
2628	my ($w, $h) = $self->text_size ($line);	2727
2629	$self->{height} += $h;	2728	$para = {
2630	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,
2631	}	2735	};
2632		2736
2633	$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;
2634	}	2749	}
2635		2750
2636	sub update {	2751	sub update {
2637	my ($self) = @_;	2752	my ($self) = @_;
2638		2753
…		…
2646	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2761	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2647		2762
2648	if (delete $self->{need_reflow}) {	2763	if (delete $self->{need_reflow}) {
2649	my $height = 0;	2764	my $height = 0;
2650		2765
2651	my $layout = $self->{layout};
2652
2653	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2654
2655	for (@{$self->{par}}) {	2766	for my $para (@{$self->{par}}) {
2656	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2767	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2657	$layout->set_width ($W - $_->[3]);	2768	my $layout = $self->get_layout ($para);
2658	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2659	$layout->set_markup ($_->[4]);
2660	my ($w, $h) = $layout->size;	2769	my ($w, $h) = $layout->size;
2661	$_->[0] = $w + $_->[3];	2770
2662	$_->[1] = $h;	2771	$para->{w} = $w + $para->{indent};
		2772	$para->{h} = $h;
		2773	$para->{wrapped} = $layout->has_wrapped;
2663	}	2774	}
2664		2775
2665	$height += $_->[1];	2776	$height += $para->{h};
2666	}	2777	}
2667		2778
2668	$self->{height} = $height;	2779	$self->{height} = $height;
2669		2780
2670	$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]);
2671		2782
2672	delete $self->{texture};	2783	delete $self->{texture};
		2784	}
		2785
		2786	if (delete $self->{scroll_to_bottom}) {
		2787	$self->{children}[1]->set_value (1e10);
2673	}	2788	}
2674		2789
2675	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2790	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2676	glClearColor 0, 0, 0, 0;	2791	glClearColor 0, 0, 0, 0;
2677	glClear GL_COLOR_BUFFER_BIT;	2792	glClear GL_COLOR_BUFFER_BIT;
…		…
2681	my $y0 = $top;	2796	my $y0 = $top;
2682	my $y1 = $top + $H;	2797	my $y1 = $top + $H;
2683		2798
2684	my $y = 0;	2799	my $y = 0;
2685		2800
2686	my $layout = $self->{layout};
2687
2688	$layout->set_font ($self->{font}) if $self->{font};
2689
2690	glEnable GL_BLEND;
2691	#TODO# not correct in windows where rgba is forced off
2692	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2693
2694	for my $par (@{$self->{par}}) {	2801	for my $para (@{$self->{par}}) {
2695	my $h = $par->[1];	2802	my $h = $para->{h};
2696		2803
2697	if ($y0 < $y + $h && $y < $y1) {	2804	if ($y0 < $y + $h && $y < $y1) {
2698	$layout->set_foreground (@{ $par->[2] });
2699	$layout->set_width ($W - $par->[3]);
2700	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2701	$layout->set_markup ($par->[4]);
2702		2805
2703	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2806	my $layout = $self->get_layout ($para);
2704		2807
2705	glRasterPos $par->[3], $y - $y0;	2808	$layout->render ($para->{indent}, $y - $y0);
2706	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	}
2707	}	2822	}
2708		2823
2709	$y += $h;	2824	$y += $h;
2710	}	2825	}
2711
2712	glDisable GL_BLEND;
2713	};	2826	};
2714	});	2827	});
		2828	}
		2829
		2830	sub reconfigure {
		2831	my ($self) = @_;
		2832
		2833	$self->SUPER::reconfigure;
		2834
		2835	$_->{w} = 1e10 for @{ $self->{par} };
		2836	$self->reflow;
2715	}	2837	}
2716		2838
2717	sub _draw {	2839	sub _draw {
2718	my ($self) = @_;	2840	my ($self) = @_;
2719		2841
…		…
2722	glColor 0, 0, 0, 1;	2844	glColor 0, 0, 0, 1;
2723	$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});
2724	glDisable GL_TEXTURE_2D;	2846	glDisable GL_TEXTURE_2D;
2725		2847
2726	$self->{children}[1]->draw;	2848	$self->{children}[1]->draw;
2727
2728	}	2849	}
2729		2850
2730	#############################################################################	2851	#############################################################################
2731		2852
2732	package CFClient::UI::Animator;	2853	package CFClient::UI::Animator;
…		…
2841	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2962	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2842		2963
2843	($w + 4, $h + 4)	2964	($w + 4, $h + 4)
2844	}	2965	}
2845		2966
2846	sub size_allocate {	2967	sub invoke_size_allocate {
2847	my ($self, $w, $h) = @_;	2968	my ($self, $w, $h) = @_;
2848		2969
2849	$self->SUPER::size_allocate ($w - 4, $h - 4);	2970	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2850	}	2971	}
2851		2972
2852	sub visibility_change {	2973	sub invoke_visibility_change {
2853	my ($self, $visible) = @_;	2974	my ($self, $visible) = @_;
2854		2975
2855	return unless $visible;	2976	return unless $visible;
2856		2977
2857	$self->{root}->on_post_alloc ("move_$self" => sub {	2978	$self->{root}->on_post_alloc ("move_$self" => sub {
…		…
3005	for my $item (@{ $self->{items} }) {	3126	for my $item (@{ $self->{items} }) {
3006	my ($widget, $cb, $tooltip) = @$item;	3127	my ($widget, $cb, $tooltip) = @$item;
3007		3128
3008	# handle various types of items, only text for now	3129	# handle various types of items, only text for now
3009	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 {
3010	$widget = new CFClient::UI::Label	3145	$widget = new CFClient::UI::Label
3011	can_hover => 1,	3146	can_hover => 1,
3012	can_events => 1,	3147	can_events => 1,
3013	markup => $widget,	3148	markup => $widget,
3014	tooltip => $tooltip	3149	tooltip => $tooltip;
		3150	}
3015	}	3151	}
3016		3152
3017	$self->{item}{$widget} = $item;	3153	$self->{item}{$widget} = $item;
3018		3154
3019	$self->{vbox}->add ($widget);	3155	$self->{vbox}->add ($widget);
…		…
3024		3160
3025	# 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)
3026	sub popup {	3162	sub popup {
3027	my ($self, $ev) = @_;	3163	my ($self, $ev) = @_;
3028		3164
3029	$self->_emit ("popdown");	3165	$self->emit ("popdown");
3030		3166
3031	# maybe save $GRAB? must be careful about events...	3167	# maybe save $GRAB? must be careful about events...
3032	$GRAB = $self;	3168	$GRAB = $self;
3033	$self->{button} = $ev->{button};	3169	$self->{button} = $ev->{button};
3034		3170
3035	$self->show;	3171	$self->show;
3036	$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);
3037	}	3173	}
3038		3174
3039	sub mouse_motion {	3175	sub invoke_mouse_motion {
3040	my ($self, $ev, $x, $y) = @_;	3176	my ($self, $ev, $x, $y) = @_;
3041		3177
3042	# TODO: should use vbox->find_widget or so	3178	# TODO: should use vbox->find_widget or so
3043	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3179	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
3044	$self->{hover} = $self->{item}{$HOVER};	3180	$self->{hover} = $self->{item}{$HOVER};
3045		3181
3046	0	3182	0
3047	}	3183	}
3048		3184
3049	sub button_up {	3185	sub invoke_button_up {
3050	my ($self, $ev, $x, $y) = @_;	3186	my ($self, $ev, $x, $y) = @_;
3051		3187
3052	if ($ev->{button} == $self->{button}) {	3188	if ($ev->{button} == $self->{button}) {
3053	undef $GRAB;	3189	undef $GRAB;
3054	$self->hide;	3190	$self->hide;
3055		3191
3056	$self->_emit ("popdown");	3192	$self->emit ("popdown");
3057	$self->{hover}[1]->() if $self->{hover};	3193	$self->{hover}[1]->() if $self->{hover};
3058	} else {	3194	} else {
3059	return 0	3195	return 0
3060	}	3196	}
3061		3197
…		…
3088		3224
3089	$self->{current} = $self->{children}[0]	3225	$self->{current} = $self->{children}[0]
3090	if @{ $self->{children} };	3226	if @{ $self->{children} };
3091	}	3227	}
3092		3228
		3229	sub get_current_page {
		3230	my ($self) = @_;
		3231
		3232	$self->{current}
		3233	}
		3234
3093	sub set_current_page {	3235	sub set_current_page {
3094	my ($self, $page_or_widget) = @_;	3236	my ($self, $page_or_widget) = @_;
3095		3237
3096	my $widget = ref $page_or_widget	3238	my $widget = ref $page_or_widget
3097	? $page_or_widget	3239	? $page_or_widget
3098	: $self->{children}[$page_or_widget];	3240	: $self->{children}[$page_or_widget];
3099		3241
3100	$self->{current} = $widget;	3242	$self->{current} = $widget;
3101	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3243	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3102		3244
3103	$self->_emit (page_changed => $self->{current});	3245	$self->emit (page_changed => $self->{current});
3104		3246
3105	$self->realloc;	3247	$self->realloc;
3106	}	3248	}
3107		3249
3108	sub visible_children {	3250	sub visible_children {
…		…
3113	my ($self) = @_;	3255	my ($self) = @_;
3114		3256
3115	$self->{current}->size_request	3257	$self->{current}->size_request
3116	}	3258	}
3117		3259
3118	sub size_allocate {	3260	sub invoke_size_allocate {
3119	my ($self, $w, $h) = @_;	3261	my ($self, $w, $h) = @_;
3120		3262
3121	$self->{current}->configure (0, 0, $w, $h);	3263	$self->{current}->configure (0, 0, $w, $h);
		3264
		3265	1
3122	}	3266	}
3123		3267
3124	sub _draw {	3268	sub _draw {
3125	my ($self) = @_;	3269	my ($self) = @_;
3126		3270
…		…
3161	);	3305	);
3162		3306
3163	$self->{multiplexer}->add ($widget);	3307	$self->{multiplexer}->add ($widget);
3164	}	3308	}
3165		3309
		3310	sub get_current_page {
		3311	my ($self) = @_;
		3312
		3313	$self->{multiplexer}->get_current_page
		3314	}
		3315
3166	sub set_current_page {	3316	sub set_current_page {
3167	my ($self, $page) = @_;	3317	my ($self, $page) = @_;
3168		3318
3169	$self->{multiplexer}->set_current_page ($page);	3319	$self->{multiplexer}->set_current_page ($page);
3170	$self->_emit (page_changed => $self->{multiplexer}{current});	3320	$self->emit (page_changed => $self->{multiplexer}{current});
3171	}	3321	}
3172		3322
3173	#############################################################################	3323	#############################################################################
3174		3324
3175	package CFClient::UI::Combobox;	3325	package CFClient::UI::Combobox;
…		…
3190	$self->_set_value ($self->{value});	3340	$self->_set_value ($self->{value});
3191		3341
3192	$self	3342	$self
3193	}	3343	}
3194		3344
3195	sub button_down {	3345	sub invoke_button_down {
3196	my ($self, $ev) = @_;	3346	my ($self, $ev) = @_;
3197		3347
3198	my @menu_items;	3348	my @menu_items;
3199		3349
3200	for (@{ $self->{options} }) {	3350	for (@{ $self->{options} }) {
…		…
3221	my ($self, $value) = @_;	3371	my ($self, $value) = @_;
3222		3372
3223	return unless $self->{value} ne $value;	3373	return unless $self->{value} ne $value;
3224		3374
3225	$self->_set_value ($value);	3375	$self->_set_value ($value);
3226	$self->_emit (changed => $value);	3376	$self->emit (changed => $value);
3227	}	3377	}
3228		3378
3229	#############################################################################	3379	#############################################################################
3230		3380
3231	package CFClient::UI::Statusbox;	3381	package CFClient::UI::Statusbox;
…		…
3346	count => 1,	3496	count => 1,
3347	%arg,	3497	%arg,
3348	};	3498	};
3349	}	3499	}
3350		3500
		3501	$ROOT->on_refresh (reorder => sub {
3351	$self->reorder;	3502	$self->reorder;
		3503	});
3352	}	3504	}
3353		3505
3354	sub reconfigure {	3506	sub reconfigure {
3355	my ($self) = @_;	3507	my ($self) = @_;
3356		3508
…		…
3371		3523
3372	#############################################################################	3524	#############################################################################
3373		3525
3374	package CFClient::UI::Inventory;	3526	package CFClient::UI::Inventory;
3375		3527
3376	our @ISA = CFClient::UI::ScrolledWindow::;	3528	our @ISA = CFClient::UI::Table::;
3377		3529
3378	sub new {	3530	sub new {
3379	my $class = shift;	3531	my $class = shift;
3380		3532
3381	my $self = $class->SUPER::new (	3533	my $self = $class->SUPER::new (
3382	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),	3534	col_expand => [0, 1, 0],
3383	@_,	3535	@_,
3384	);	3536	);
3385		3537
3386	$self	3538	$self
3387	}	3539	}
3388		3540
3389	sub set_items {	3541	sub set_items {
3390	my ($self, $items) = @_;	3542	my ($self, $items) = @_;
3391		3543
3392	$self->{child}->clear;	3544	$self->clear;
3393	return unless $items;	3545	return unless $items;
3394		3546
3395	my @items = sort {	3547	my @items = sort {
3396	($a->{type} <=> $b->{type})	3548	($a->{type} <=> $b->{type})
3397	or ($a->{name} cmp $b->{name})	3549	or ($a->{name} cmp $b->{name})
3398	} @$items;	3550	} values %$items;
3399		3551
3400	$self->{real_items} = \@items;	3552	$self->{real_items} = \@items;
3401		3553
3402	my $row = 0;	3554	my $row = 0;
3403	for my $item (@items) {	3555	for my $item (@items) {
3404	CFClient::Item::update_widgets $item;	3556	CFClient::Item::update_widgets $item;
3405		3557
3406	$self->{child}->add (0, $row, $item->{face_widget});	3558	$self->add (0, $row, $item->{face_widget});
3407	$self->{child}->add (1, $row, $item->{desc_widget});	3559	$self->add (1, $row, $item->{desc_widget});
3408	$self->{child}->add (2, $row, $item->{weight_widget});	3560	$self->add (2, $row, $item->{weight_widget});
3409		3561
3410	$row++;	3562	$row++;
3411	}
3412	}
3413
3414	#############################################################################
3415
3416	package CFClient::UI::BindEditor;
3417
3418	our @ISA = CFClient::UI::FancyFrame::;
3419
3420	sub new {
3421	my $class = shift;
3422
3423	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3424
3425	$self->add (my $vb = new CFClient::UI::VBox);
3426
3427
3428	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3429	text => "start recording",
3430	tooltip => "Start/Stops recording of actions."
3431	."All subsequent actions after the recording started will be captured."
3432	."The actions are displayed after the record was stopped."
3433	."To bind the action you have to click on the 'Bind' button",
3434	on_activate => sub {
3435	unless ($self->{recording}) {
3436	$self->start;
3437	} else {
3438	$self->stop;
3439	}
3440	});
3441
3442	$vb->add (new CFClient::UI::Label text => "Actions:");
3443	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3444
3445	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3446	$vb->add (my $hb = new CFClient::UI::HBox);
3447	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3448	$hb->add (new CFClient::UI::Button
3449	text => "bind",
3450	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3451	on_activate => sub {
3452	$self->ask_for_bind;
3453	});
3454
3455	$vb->add (my $hb = new CFClient::UI::HBox);
3456	$hb->add (new CFClient::UI::Button
3457	text => "ok",
3458	expand => 1,
3459	tooltip => "This closes the binding editor and saves the binding",
3460	on_activate => sub {
3461	$self->hide;
3462	$self->commit;
3463	});
3464
3465	$hb->add (new CFClient::UI::Button
3466	text => "cancel",
3467	expand => 1,
3468	tooltip => "This closes the binding editor without saving",
3469	on_activate => sub {
3470	$self->hide;
3471	$self->{binding_cancel}->()
3472	if $self->{binding_cancel};
3473	});
3474
3475	$self->update_binding_widgets;
3476
3477	$self
3478	}
3479
3480	sub commit {
3481	my ($self) = @_;
3482	my ($mod, $sym, $cmds) = $self->get_binding;
3483	if ($sym != 0 && @$cmds > 0) {
3484	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3485	."'. Don't forget 'Save Config'!");
3486	$self->{binding_change}->($mod, $sym, $cmds)
3487	if $self->{binding_change};
3488	} else {
3489	$::STATUSBOX->add ("No action bound, no key or action specified!");
3490	$self->{binding_cancel}->()
3491	if $self->{binding_cancel};
3492	}
3493	}
3494
3495	sub start {
3496	my ($self) = @_;
3497
3498	$self->{rec_btn}->set_text ("stop recording");
3499	$self->{recording} = 1;
3500	$self->clear_command_list;
3501	$::CONN->start_record if $::CONN;
3502	}
3503
3504	sub stop {
3505	my ($self) = @_;
3506
3507	$self->{rec_btn}->set_text ("start recording");
3508	$self->{recording} = 0;
3509
3510	my $rec;
3511	$rec = $::CONN->stop_record if $::CONN;
3512	return unless ref $rec eq 'ARRAY';
3513	$self->set_command_list ($rec);
3514	}
3515
3516
3517	sub ask_for_bind_and_commit {
3518	my ($self) = @_;
3519	$self->ask_for_bind (1);
3520	}
3521
3522	sub ask_for_bind {
3523	my ($self, $commit, $end_cb) = @_;
3524
3525	CFClient::Binder::open_binding_dialog (sub {
3526	my ($mod, $sym) = @_;
3527	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3528	$self->update_binding_widgets;
3529	$self->commit if $commit;
3530	$end_cb->() if $end_cb;
3531	});
3532	}
3533
3534	# $mod and $sym are the modifiers and key symbol
3535	# $cmds is a array ref of strings (the commands)
3536	# $cb is the callback that is executed on OK
3537	# $ccb is the callback that is executed on CANCEL and
3538	# when the binding was unsuccessful on OK
3539	sub set_binding {
3540	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3541
3542	$self->clear_command_list;
3543	$self->{recording} = 0;
3544	$self->{rec_btn}->set_text ("start recording");
3545
3546	$self->{binding} = [$mod, $sym];
3547	$self->{commands} = $cmds;
3548
3549	$self->{binding_change} = $cb;
3550	$self->{binding_cancel} = $ccb;
3551
3552	$self->update_binding_widgets;
3553	}
3554
3555	# this is a shortcut method that asks for a binding
3556	# and then just binds it.
3557	sub do_quick_binding {
3558	my ($self, $cmds, $end_cb) = @_;
3559	$self->set_binding (undef, undef, $cmds, sub {
3560	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3561	});
3562	$self->ask_for_bind (1, $end_cb);
3563	}
3564
3565	sub update_binding_widgets {
3566	my ($self) = @_;
3567	my ($mod, $sym, $cmds) = $self->get_binding;
3568	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3569	$self->set_command_list ($cmds);
3570	}
3571
3572	sub get_binding {
3573	my ($self) = @_;
3574	return (
3575	$self->{binding}->[0],
3576	$self->{binding}->[1],
3577	[ grep { defined $_ } @{$self->{commands}} ]
3578	);
3579	}
3580
3581	sub clear_command_list {
3582	my ($self) = @_;
3583	$self->{cmdbox}->clear ();
3584	}
3585
3586	sub set_command_list {
3587	my ($self, $cmds) = @_;
3588
3589	$self->{cmdbox}->clear ();
3590	$self->{commands} = $cmds;
3591
3592	my $idx = 0;
3593
3594	for (@$cmds) {
3595	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3596
3597	my $i = $idx;
3598	$hb->add (new CFClient::UI::Label text => $_);
3599	$hb->add (new CFClient::UI::Button
3600	text => "delete",
3601	tooltip => "Deletes the action from the record",
3602	on_activate => sub {
3603	$self->{cmdbox}->remove ($hb);
3604	$cmds->[$i] = undef;
3605	});
3606
3607
3608	$idx++
3609	}	3563	}
3610	}	3564	}
3611		3565
3612	#############################################################################	3566	#############################################################################
3613		3567
…		…
3667	} elsif ($ev->{button} == 2) {	3621	} elsif ($ev->{button} == 2) {
3668	$::CONN->user_send ("invoke $spell->{name}");	3622	$::CONN->user_send ("invoke $spell->{name}");
3669	} elsif ($ev->{button} == 3) {	3623	} elsif ($ev->{button} == 3) {
3670	(new CFClient::UI::Menu	3624	(new CFClient::UI::Menu
3671	items => [	3625	items => [
3672	["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}"]) }],
3673	["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}"]) }],
3674	],	3628	],
3675	)->popup ($ev);	3629	)->popup ($ev);
3676	} else {	3630	} else {
3677	return 0;	3631	return 0;
…		…
3772	$coord = $max - $size if $coord > $max - $size;	3726	$coord = $max - $size if $coord > $max - $size;
3773		3727
3774	int $coord + 0.5	3728	int $coord + 0.5
3775	}	3729	}
3776		3730
3777	sub size_allocate {	3731	sub invoke_size_allocate {
3778	my ($self, $w, $h) = @_;	3732	my ($self, $w, $h) = @_;
3779		3733
3780	for my $child ($self->children) {	3734	for my $child ($self->children) {
3781	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)};
3782		3736
…		…
3786	$X = _to_pixel $X, $W, $self->{w};	3740	$X = _to_pixel $X, $W, $self->{w};
3787	$Y = _to_pixel $Y, $H, $self->{h};	3741	$Y = _to_pixel $Y, $H, $self->{h};
3788		3742
3789	$child->configure ($X, $Y, $W, $H);	3743	$child->configure ($X, $Y, $W, $H);
3790	}	3744	}
		3745
		3746	1
3791	}	3747	}
3792		3748
3793	sub coord2local {	3749	sub coord2local {
3794	my ($self, $x, $y) = @_;	3750	my ($self, $x, $y) = @_;
3795		3751
…		…
3921	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3877	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3922		3878
3923	$w = 0 if $w < 0;	3879	$w = 0 if $w < 0;
3924	$h = 0 if $h < 0;	3880	$h = 0 if $h < 0;
3925		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
3926	$w = int $w + 0.5;	3888	$w = int $w + 0.5;
3927	$h = int $h + 0.5;	3889	$h = int $h + 0.5;
3928		3890
3929	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}) {
3930	$widget->{old_w} = $widget->{w};	3892	$widget->{old_w} = $widget->{w};

Diff Legend

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