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.331 by root, Sun Jul 23 04:46:02 2006 UTC

…		…
79	sub feed_sdl_key_up_event {	79	sub feed_sdl_key_up_event {
80	$FOCUS->emit (key_up => $_[0])	80	$FOCUS->emit (key_up => $_[0])
81	if $FOCUS;	81	if $FOCUS;
82	}	82	}
83		83
		84	sub check_hover {
		85	my ($widget) = @_;
		86
		87	if ($widget != $HOVER) {
		88	my $hover = $HOVER; $HOVER = $widget;
		89
		90	$hover->update if $hover && $hover->{can_hover};
		91	$HOVER->update if $HOVER && $HOVER->{can_hover};
		92
		93	$TOOLTIP_WATCHER->start;
		94	}
		95	}
		96
84	sub feed_sdl_button_down_event {	97	sub feed_sdl_button_down_event {
85	my ($ev) = @_;	98	my ($ev) = @_;
86	my ($x, $y) = ($ev->{x}, $ev->{y});	99	my ($x, $y) = ($ev->{x}, $ev->{y});
87		100
88	if (!$BUTTON_STATE) {	101	unless ($BUTTON_STATE) {
89	my $widget = $ROOT->find_widget ($x, $y);	102	my $widget = $ROOT->find_widget ($x, $y);
90		103
91	$GRAB = $widget;	104	$GRAB = $widget;
92	$GRAB->update if $GRAB;	105	$GRAB->update if $GRAB;
93		106
94	$TOOLTIP_WATCHER->cb->();	107	$TOOLTIP_WATCHER->cb->();
95	}	108	}
96		109
97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	110	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
98		111
99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	112	if ($GRAB) {
100	if $GRAB;	113	if ($ev->{button} == 4 || $ev->{button} == 5) {
		114	# mousewheel
		115	$ev->{dx} = 0;
		116	$ev->{dy} = $ev->{button} * 2 - 9;
		117	$GRAB->emit (mouse_wheel => $ev);
		118	} else {
		119	$GRAB->emit (button_down => $ev)
		120	}
		121	}
101	}	122	}
102		123
103	sub feed_sdl_button_up_event {	124	sub feed_sdl_button_up_event {
104	my ($ev) = @_;	125	my ($ev) = @_;
105	my ($x, $y) = ($ev->{x}, $ev->{y});
106		126
107	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	127	my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
108		128
109	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	129	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
110		130
111	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))	131	$GRAB->emit (button_up => $ev)
112	if $GRAB;	132	if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
113		133
114	if (!$BUTTON_STATE) {	134	unless ($BUTTON_STATE) {
115	my $grab = $GRAB; undef $GRAB;	135	my $grab = $GRAB; undef $GRAB;
116	$grab->update if $grab;	136	$grab->update if $grab;
117	$GRAB->update if $GRAB;	137	$GRAB->update if $GRAB;
118		138
		139	check_hover $widget;
119	$TOOLTIP_WATCHER->cb->();	140	$TOOLTIP_WATCHER->cb->();
120	}	141	}
121	}	142	}
122		143
123	sub feed_sdl_motion_event {	144	sub feed_sdl_motion_event {
124	my ($ev) = @_;	145	my ($ev) = @_;
125	my ($x, $y) = ($ev->{x}, $ev->{y});	146	my ($x, $y) = ($ev->{x}, $ev->{y});
126		147
127	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	148	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
128		149
129	if ($widget != $HOVER) {	150	check_hover $widget;
130	my $hover = $HOVER; $HOVER = $widget;
131		151
132	$hover->update if $hover && $hover->{can_hover};	152	$HOVER->emit (mouse_motion => $ev)
133	$HOVER->update if $HOVER && $HOVER->{can_hover};
134
135	$TOOLTIP_WATCHER->start;
136	}
137
138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
139	if $HOVER;	153	if $HOVER;
140	}	154	}
141		155
142	# convert position array to integers	156	# convert position array to integers
143	sub harmonize {	157	sub harmonize {
…		…
189		203
190	}	204	}
191	}	205	}
192		206
193	reconfigure_widgets;	207	reconfigure_widgets;
		208	}
		209
		210	#############################################################################
		211
		212	package CFClient::UI::Event;
		213
		214	sub xy {
		215	$_[1]->coord2local ($_[0]{x}, $_[0]{y})
194	}	216	}
195		217
196	#############################################################################	218	#############################################################################
197		219
198	package CFClient::UI::Base;	220	package CFClient::UI::Base;
…		…
281	undef $HOVER if $HOVER == $self;	303	undef $HOVER if $HOVER == $self;
282		304
283	$CFClient::UI::TOOLTIP_WATCHER->cb->()	305	$CFClient::UI::TOOLTIP_WATCHER->cb->()
284	if $TOOLTIP->{owner} == $self;	306	if $TOOLTIP->{owner} == $self;
285		307
286	$self->focus_out;	308	$self->emit ("focus_out");
287
288	$self->emit (visibility_change => 0);	309	$self->emit (visibility_change => 0);
289	}	310	}
290		311
291	sub set_visibility {	312	sub set_visibility {
292	my ($self, $visible) = @_;	313	my ($self, $visible) = @_;
…		…
334	}	355	}
335		356
336	sub size_request {	357	sub size_request {
337	require Carp;	358	require Carp;
338	Carp::confess "size_request is abstract";	359	Carp::confess "size_request is abstract";
		360	}
		361
		362	sub baseline_shift {
		363	0
339	}	364	}
340		365
341	sub configure {	366	sub configure {
342	my ($self, $x, $y, $w, $h) = @_;	367	my ($self, $x, $y, $w, $h) = @_;
343		368
…		…
367		392
368	$self->{root}{size_alloc}{$self+0} = $self;	393	$self->{root}{size_alloc}{$self+0} = $self;
369	}	394	}
370	}	395	}
371		396
372	sub size_allocate {
373	# nothing to be done
374	}
375
376	sub children {	397	sub children {
377	# nop	398	# nop
378	}	399	}
379		400
380	sub visible_children {	401	sub visible_children {
…		…
408		429
409	# translate global coordinates to local coordinate system	430	# translate global coordinates to local coordinate system
410	sub coord2local {	431	sub coord2local {
411	my ($self, $x, $y) = @_;	432	my ($self, $x, $y) = @_;
412		433
		434	Carp::confess unless $self->{parent};#d#
		435
413	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})	436	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
414	}	437	}
415		438
416	# translate local coordinates to global coordinate system	439	# translate local coordinates to global coordinate system
417	sub coord2global {	440	sub coord2global {
418	my ($self, $x, $y) = @_;	441	my ($self, $x, $y) = @_;
419		442
420	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	443	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421	}	444	}
422		445
423	sub focus_in {	446	sub invoke_focus_in {
424	my ($self) = @_;	447	my ($self) = @_;
425		448
426	return if $FOCUS == $self;	449	return if $FOCUS == $self;
427	return unless $self->{can_focus};	450	return unless $self->{can_focus};
428		451
429	my $focus = $FOCUS; $FOCUS = $self;	452	$FOCUS = $self;
430		453
431	$self->_emit (focus_in => $focus);	454	$self->update;
432		455
433	$focus->update if $focus;	456	0
434	$FOCUS->update;
435	}	457	}
436		458
437	sub focus_out {	459	sub invoke_focus_out {
438	my ($self) = @_;	460	my ($self) = @_;
439		461
440	return unless $FOCUS == $self;	462	return unless $FOCUS == $self;
441		463
442	my $focus = $FOCUS; undef $FOCUS;	464	undef $FOCUS;
443		465
444	$self->_emit (focus_out => $focus);	466	$self->update;
445		467
446	$focus->update if $focus; #?
447
448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	468	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449	unless $FOCUS;	469	unless $FOCUS;
450	}
451		470
		471	0
		472	}
		473
		474	sub grab_focus {
		475	my ($self) = @_;
		476
		477	$FOCUS->emit ("focus_out") if $FOCUS;
		478	$self->emit ("focus_in");
		479	}
		480
452	sub mouse_motion { 0 }	481	sub invoke_mouse_motion { 0 }
453	sub button_up { 0 }	482	sub invoke_button_up { 0 }
454	sub key_down { 0 }	483	sub invoke_key_down { 0 }
455	sub key_up { 0 }	484	sub invoke_key_up { 0 }
		485	sub invoke_mouse_wheel { 0 }
456		486
457	sub button_down {	487	sub invoke_button_down {
458	my ($self, $ev, $x, $y) = @_;	488	my ($self, $ev, $x, $y) = @_;
459		489
460	$self->focus_in;	490	$self->grab_focus;
461		491
462	0	492	0
		493	}
		494
		495	sub connect {
		496	my ($self, $signal, $cb) = @_;
		497
		498	push @{ $self->{signal_cb}{$signal} }, $cb;
		499	}
		500
		501	my %has_coords = (
		502	button_down => 1,
		503	button_up => 1,
		504	mouse_motion => 1,
		505	mouse_wheel => 1,
		506	);
		507
		508	sub emit {
		509	my ($self, $signal, @args) = @_;
		510
		511	my @append
		512	= $has_coords{$signal}
		513	? $args[0]->xy ($self)
		514	: ();
		515
		516	#warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
		517
		518	#d##TODO# stop propagating at first true, do not use sum
		519	(List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
		520	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append) # closure
		521	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
463	}	522	}
464		523
465	sub find_widget {	524	sub find_widget {
466	my ($self, $x, $y) = @_;	525	my ($self, $x, $y) = @_;
467		526
…		…
477	sub set_parent {	536	sub set_parent {
478	my ($self, $parent) = @_;	537	my ($self, $parent) = @_;
479		538
480	Scalar::Util::weaken ($self->{parent} = $parent);	539	Scalar::Util::weaken ($self->{parent} = $parent);
481	$self->set_visible if $parent->{visible};	540	$self->set_visible if $parent->{visible};
482	}
483
484	sub connect {
485	my ($self, $signal, $cb) = @_;
486
487	push @{ $self->{signal_cb}{$signal} }, $cb;
488	}
489
490	sub _emit {
491	my ($self, $signal, @args) = @_;
492
493	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
494	}
495
496	sub emit {
497	my ($self, $signal, @args) = @_;
498
499	$self->_emit ($signal, @args)
500	|| $self->$signal (@args);
501	}
502
503	sub visibility_change {
504	#my ($self, $visible) = @_;
505	}	541	}
506		542
507	sub realloc {	543	sub realloc {
508	my ($self) = @_;	544	my ($self) = @_;
509		545
…		…
542	return unless $self->{h} && $self->{w};	578	return unless $self->{h} && $self->{w};
543		579
544	# update screen rectangle	580	# update screen rectangle
545	local $draw_x = $draw_x + $self->{x};	581	local $draw_x = $draw_x + $self->{x};
546	local $draw_y = $draw_y + $self->{y};	582	local $draw_y = $draw_y + $self->{y};
547	local $draw_w = $draw_x + $self->{w};
548	local $draw_h = $draw_y + $self->{h};
549		583
550	# skip widgets that are entirely outside the drawing area	584	# skip widgets that are entirely outside the drawing area
551	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)	585	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
552	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);	586	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
553		587
…		…
592	}	626	}
593		627
594	sub DESTROY {	628	sub DESTROY {
595	my ($self) = @_;	629	my ($self) = @_;
596		630
		631	return if CFClient::in_destruct;
		632
597	delete $WIDGET{$self+0};	633	delete $WIDGET{$self+0};
598		634
599	eval { $self->destroy };	635	eval { $self->destroy };
600	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;	636	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
601	}	637	}
…		…
789		825
790	sub size_request {	826	sub size_request {
791	$_[0]{children}[0]->size_request	827	$_[0]{children}[0]->size_request
792	}	828	}
793		829
794	sub size_allocate {	830	sub invoke_size_allocate {
795	my ($self, $w, $h) = @_;	831	my ($self, $w, $h) = @_;
796		832
797	$self->{children}[0]->configure (0, 0, $w, $h);	833	$self->{children}[0]->configure (0, 0, $w, $h);
		834
		835	1
798	}	836	}
799		837
800	#############################################################################	838	#############################################################################
801		839
802	# back-buffered drawing area	840	# back-buffered drawing area
…		…
818		856
819	$ROOT->on_post_alloc ($self => sub { $self->render_child });	857	$ROOT->on_post_alloc ($self => sub { $self->render_child });
820	$self->SUPER::update;	858	$self->SUPER::update;
821	}	859	}
822		860
823	sub size_allocate {	861	sub invoke_size_allocate {
824	my ($self, $w, $h) = @_;	862	my ($self, $w, $h) = @_;
825		863
826	$self->SUPER::size_allocate ($w, $h);
827	$self->update;	864	$self->update;
		865
		866	$self->SUPER::invoke_size_allocate ($w, $h)
828	}	867	}
829		868
830	sub _render {	869	sub _render {
831	my ($self) = @_;	870	my ($self) = @_;
832		871
…		…
893	$h = 10 if $self->{scroll_y};	932	$h = 10 if $self->{scroll_y};
894		933
895	($w, $h)	934	($w, $h)
896	}	935	}
897		936
898	sub size_allocate {	937	sub invoke_size_allocate {
899	my ($self, $w, $h) = @_;	938	my ($self, $w, $h) = @_;
900		939
901	my $child = $self->child;	940	my $child = $self->child;
902		941
903	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};	942	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
904	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};	943	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
905		944
906	$self->child->configure (0, 0, $w, $h);	945	$self->child->configure (0, 0, $w, $h);
907	$self->update;	946	$self->update;
		947
		948	1
908	}	949	}
909		950
910	sub set_offset {	951	sub set_offset {
911	my ($self, $x, $y) = @_;	952	my ($self, $x, $y) = @_;
912		953
…		…
975	$self->{vp}->set_offset (0, $_[1]);	1016	$self->{vp}->set_offset (0, $_[1]);
976	},	1017	},
977	;	1018	;
978		1019
979	$self = $class->SUPER::new (	1020	$self = $class->SUPER::new (
980	vp => (new CFClient::UI::ViewPort expand => 1),	1021	vp => (new CFClient::UI::ViewPort expand => 1),
		1022	can_events => 1,
981	slider => $slider,	1023	slider => $slider,
982	%arg,	1024	%arg,
983	);	1025	);
984		1026
985	$self->SUPER::add ($self->{vp}, $self->{slider});	1027	$self->SUPER::add ($self->{vp}, $self->{slider});
986	$self->add ($child) if $child;	1028	$self->add ($child) if $child;
987		1029
988	$self	1030	$self
989	}	1031	}
990		1032
		1033	#TODO# update range on size_allocate depending on child
		1034
991	sub add {	1035	sub add {
992	my ($self, $widget) = @_;	1036	my ($self, $widget) = @_;
993		1037
994	$self->{vp}->add ($self->{child} = $widget);	1038	$self->{vp}->add ($self->{child} = $widget);
995	}	1039	}
996		1040
		1041	sub invoke_mouse_wheel {
		1042	my ($self, $ev) = @_;
		1043
		1044	return 0 unless $ev->{dy}; # only vertical movements
		1045
		1046	$self->{slider}->emit (mouse_wheel => $ev);
		1047
		1048	1
		1049	}
		1050
		1051	sub update_slider {
		1052	my ($self) = @_;
		1053
		1054	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
		1055	}
		1056
997	sub update {	1057	sub update {
998	my ($self) = @_;	1058	my ($self) = @_;
999		1059
1000	$self->SUPER::update;	1060	$self->SUPER::update;
1001		1061
1002	# todo: overwrite size_allocate of child	1062	$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	}	1063	}
1006		1064
1007	sub size_allocate {	1065	sub invoke_size_allocate {
1008	my ($self, $w, $h) = @_;	1066	my ($self, $w, $h) = @_;
1009		1067
		1068	$self->update_slider;
		1069
1010	$self->SUPER::size_allocate ($w, $h);	1070	$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	}	1071	}
1015
1016	#TODO# update range on size_allocate depending on child
1017	# update viewport offset on scroll
1018		1072
1019	#############################################################################	1073	#############################################################################
1020		1074
1021	package CFClient::UI::Frame;	1075	package CFClient::UI::Frame;
1022		1076
…		…
1078	my $self = $class->SUPER::new (	1132	my $self = $class->SUPER::new (
1079	bg => [1, 1, 1, 1],	1133	bg => [1, 1, 1, 1],
1080	border_bg => [1, 1, 1, 1],	1134	border_bg => [1, 1, 1, 1],
1081	border => 0.6,	1135	border => 0.6,
1082	can_events => 1,	1136	can_events => 1,
1083	min_w => 16,	1137	min_w => 64,
1084	min_h => 16,	1138	min_h => 32,
1085	%arg,	1139	%arg,
1086	);	1140	);
1087		1141
1088	$self->{title_widget} = new CFClient::UI::Label	1142	$self->{title_widget} = new CFClient::UI::Label
1089	align => 0,	1143	align => 0,
1090	valign => 1,	1144	valign => 1,
1091	text => $self->{title},	1145	text => $self->{title},
1092	fontsize => $self->{border},	1146	fontsize => $self->{border},
1093	if exists $self->{title};	1147	if exists $self->{title};
1094		1148
		1149	if ($self->{has_close_button}) {
		1150	$self->{close_button} =
		1151	new CFClient::UI::ImageButton
		1152	path => 'x1_close.png',
		1153	on_activate => sub { $self->emit ("delete") };
		1154
		1155	$self->CFClient::UI::Container::add ($self->{close_button});
		1156	}
		1157
1095	$self	1158	$self
1096	}	1159	}
1097		1160
1098	sub add {	1161	sub add {
1099	my ($self, @widgets) = @_;	1162	my ($self, @widgets) = @_;
1100		1163
1101	$self->SUPER::add (@widgets);	1164	$self->SUPER::add (@widgets);
		1165	$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};	1166	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1103	}	1167	}
1104		1168
1105	sub border {	1169	sub border {
1106	int $_[0]{border} * $::FONTSIZE	1170	int $_[0]{border} * $::FONTSIZE
…		…
1109	sub size_request {	1173	sub size_request {
1110	my ($self) = @_;	1174	my ($self) = @_;
1111		1175
1112	$self->{title_widget}->size_request	1176	$self->{title_widget}->size_request
1113	if $self->{title_widget};	1177	if $self->{title_widget};
		1178
		1179	$self->{close_button}->size_request
		1180	if $self->{close_button};
1114		1181
1115	my ($w, $h) = $self->SUPER::size_request;	1182	my ($w, $h) = $self->SUPER::size_request;
1116		1183
1117	(	1184	(
1118	$w + $self->border * 2,	1185	$w + $self->border * 2,
1119	$h + $self->border * 2,	1186	$h + $self->border * 2,
1120	)	1187	)
1121	}	1188	}
1122		1189
1123	sub size_allocate {	1190	sub invoke_size_allocate {
1124	my ($self, $w, $h) = @_;	1191	my ($self, $w, $h) = @_;
1125		1192
1126	if ($self->{title_widget}) {	1193	if ($self->{title_widget}) {
1127	$self->{title_widget}{w} = $w;	1194	$self->{title_widget}{w} = $w;
1128	$self->{title_widget}{h} = $h;	1195	$self->{title_widget}{h} = $h;
1129	$self->{title_widget}->size_allocate ($w, $h);	1196	$self->{title_widget}->invoke_size_allocate ($w, $h);
1130	}	1197	}
1131		1198
1132	my $border = $self->border;	1199	my $border = $self->border;
1133		1200
1134	$h -= List::Util::max 0, $border * 2;	1201	$h -= List::Util::max 0, $border * 2;
1135	$w -= List::Util::max 0, $border * 2;	1202	$w -= List::Util::max 0, $border * 2;
		1203
		1204	$self->child->configure ($border, $border, $w, $h);
		1205
		1206	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1207	if $self->{close_button};
		1208
		1209	1
		1210	}
		1211
		1212	sub invoke_delete {
		1213	my ($self) = @_;
		1214
		1215	$self->hide;
1136		1216
1137	$self->child->configure ($border, $border, $w, $h);	1217	1
1138	}	1218	}
1139		1219
1140	sub button_down {	1220	sub invoke_button_down {
1141	my ($self, $ev, $x, $y) = @_;	1221	my ($self, $ev, $x, $y) = @_;
1142		1222
1143	my ($w, $h) = @$self{qw(w h)};	1223	my ($w, $h) = @$self{qw(w h)};
1144	my $border = $self->border;	1224	my $border = $self->border;
1145		1225
…		…
1176		1256
1177	($x, $y) = ($ev->{x}, $ev->{y});	1257	($x, $y) = ($ev->{x}, $ev->{y});
1178		1258
1179	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1259	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1180	# HACK: the next line is required to enforce placement	1260	# HACK: the next line is required to enforce placement
1181	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1261	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1182	};	1262	};
1183	} else {	1263	} else {
1184	return 0;	1264	return 0;
1185	}	1265	}
1186		1266
1187	1	1267	1
1188	}	1268	}
1189		1269
1190	sub button_up {	1270	sub invoke_button_up {
1191	my ($self, $ev, $x, $y) = @_;	1271	my ($self, $ev, $x, $y) = @_;
1192		1272
1193	!!delete $self->{motion}	1273	! ! delete $self->{motion}
1194	}	1274	}
1195		1275
1196	sub mouse_motion {	1276	sub invoke_mouse_motion {
1197	my ($self, $ev, $x, $y) = @_;	1277	my ($self, $ev, $x, $y) = @_;
1198		1278
1199	$self->{motion}->($ev, $x, $y) if $self->{motion};	1279	$self->{motion}->($ev, $x, $y) if $self->{motion};
1200		1280
1201	!!$self->{motion}	1281	! ! $self->{motion}
1202	}	1282	}
1203		1283
1204	sub _draw {	1284	sub _draw {
1205	my ($self) = @_;	1285	my ($self) = @_;
1206		1286
…		…
1235	$child->draw;	1315	$child->draw;
1236		1316
1237	if ($self->{title_widget}) {	1317	if ($self->{title_widget}) {
1238	glTranslate 0, $border - $self->{h};	1318	glTranslate 0, $border - $self->{h};
1239	$self->{title_widget}->_draw;	1319	$self->{title_widget}->_draw;
		1320
		1321	glTranslate 0, - ($border - $self->{h});
1240	}	1322	}
		1323
		1324	$self->{close_button}->draw
		1325	if $self->{close_button};
1241	}	1326	}
1242		1327
1243	#############################################################################	1328	#############################################################################
1244		1329
1245	package CFClient::UI::Table;	1330	package CFClient::UI::Table;
…		…
1324	(sum @$ws),	1409	(sum @$ws),
1325	(sum @$hs),	1410	(sum @$hs),
1326	)	1411	)
1327	}	1412	}
1328		1413
1329	sub size_allocate {	1414	sub invoke_size_allocate {
1330	my ($self, $w, $h) = @_;	1415	my ($self, $w, $h) = @_;
1331		1416
1332	my ($ws, $hs) = $self->get_wh;	1417	my ($ws, $hs) = $self->get_wh;
1333		1418
1334	my $req_w = (sum @$ws) || 1;	1419	my $req_w = (sum @$ws) || 1;
…		…
1366	}	1451	}
1367		1452
1368	$y += $row_h;	1453	$y += $row_h;
1369	}	1454	}
1370		1455
		1456	1
1371	}	1457	}
1372		1458
1373	sub find_widget {	1459	sub find_widget {
1374	my ($self, $x, $y) = @_;	1460	my ($self, $x, $y) = @_;
1375		1461
…		…
1412	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1498	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1413	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1499	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1414	)	1500	)
1415	}	1501	}
1416		1502
1417	sub size_allocate {	1503	sub invoke_size_allocate {
1418	my ($self, $w, $h) = @_;	1504	my ($self, $w, $h) = @_;
1419		1505
1420	my $space = $self->{vertical} ? $h : $w;	1506	my $space = $self->{vertical} ? $h : $w;
1421	my $children = $self->{children};	1507	my @children = $self->visible_children;
1422		1508
1423	my @req;	1509	my @req;
1424		1510
1425	if ($self->{homogeneous}) {	1511	if ($self->{homogeneous}) {
1426	@req = ($space / (@$children || 1)) x @$children;	1512	@req = ($space / (@children || 1)) x @children;
1427	} else {	1513	} else {
1428	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1514	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1429	my $req = List::Util::sum @req;	1515	my $req = List::Util::sum @req;
1430		1516
1431	if ($req > $space) {	1517	if ($req > $space) {
1432	# ah well, not enough space	1518	# ah well, not enough space
1433	$_ *= $space / $req for @req;	1519	$_ *= $space / $req for @req;
1434	} else {	1520	} else {
1435	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1521	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1436		1522
1437	$space = ($space - $req) / $expand; # remaining space to give away	1523	$space = ($space - $req) / $expand; # remaining space to give away
1438		1524
1439	$req[$_] += $space * $children->[$_]{expand}	1525	$req[$_] += $space * $children[$_]{expand}
1440	for 0 .. $#$children;	1526	for 0 .. $#children;
1441	}	1527	}
1442	}	1528	}
1443		1529
1444	CFClient::UI::harmonize \@req;	1530	CFClient::UI::harmonize \@req;
1445		1531
1446	my $pos = 0;	1532	my $pos = 0;
1447	for (0 .. $#$children) {	1533	for (0 .. $#children) {
1448	my $alloc = $req[$_];	1534	my $alloc = $req[$_];
1449	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1535	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1450		1536
1451	$pos += $alloc;	1537	$pos += $alloc;
1452	}	1538	}
1453		1539
1454	1	1540	1
…		…
1557	my ($self, $text) = @_;	1643	my ($self, $text) = @_;
1558		1644
1559	return if $self->{text} eq "T$text";	1645	return if $self->{text} eq "T$text";
1560	$self->{text} = "T$text";	1646	$self->{text} = "T$text";
1561		1647
1562	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1563	$self->{layout}->set_text ($text);	1648	$self->{layout}->set_text ($text);
1564		1649
1565	delete $self->{size_req};	1650	delete $self->{size_req};
1566	$self->realloc;	1651	$self->realloc;
1567	$self->update;	1652	$self->update;
…		…
1573	return if $self->{text} eq "M$markup";	1658	return if $self->{text} eq "M$markup";
1574	$self->{text} = "M$markup";	1659	$self->{text} = "M$markup";
1575		1660
1576	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1661	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1577		1662
1578	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1579	$self->{layout}->set_markup ($markup);	1663	$self->{layout}->set_markup ($markup);
1580		1664
1581	delete $self->{size_req};	1665	delete $self->{size_req};
1582	$self->realloc;	1666	$self->realloc;
1583	$self->update;	1667	$self->update;
…		…
1595		1679
1596	my ($w, $h) = $self->{layout}->size;	1680	my ($w, $h) = $self->{layout}->size;
1597		1681
1598	if (exists $self->{template}) {	1682	if (exists $self->{template}) {
1599	$self->{template}->set_font ($self->{font}) if $self->{font};	1683	$self->{template}->set_font ($self->{font}) if $self->{font};
		1684	$self->{template}->set_width ($self->{max_w} || -1);
1600	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1685	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1601		1686
1602	my ($w2, $h2) = $self->{template}->size;	1687	my ($w2, $h2) = $self->{template}->size;
1603		1688
1604	$w = List::Util::max $w, $w2;	1689	$w = List::Util::max $w, $w2;
…		…
1609	};	1694	};
1610		1695
1611	@{ $self->{size_req} }	1696	@{ $self->{size_req} }
1612	}	1697	}
1613		1698
		1699	sub baseline_shift {
		1700	$_[0]{layout}->descent
		1701	}
		1702
1614	sub size_allocate {	1703	sub invoke_size_allocate {
1615	my ($self, $w, $h) = @_;	1704	my ($self, $w, $h) = @_;
1616		1705
1617	delete $self->{ox};	1706	delete $self->{ox};
1618		1707
1619	delete $self->{texture}	1708	delete $self->{texture}
1620	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};	1709	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1710
		1711	1
1621	}	1712	}
1622		1713
1623	sub set_fontsize {	1714	sub set_fontsize {
1624	my ($self, $fontsize) = @_;	1715	my ($self, $fontsize) = @_;
1625		1716
1626	$self->{fontsize} = $fontsize;	1717	$self->{fontsize} = $fontsize;
		1718	delete $self->{size_req};
1627	delete $self->{texture};	1719	delete $self->{texture};
1628		1720
1629	$self->realloc;	1721	$self->realloc;
1630	}	1722	}
1631		1723
1632	sub reconfigure {	1724	sub reconfigure {
1633	my ($self) = @_;	1725	my ($self) = @_;
1634		1726
1635	delete $self->{size_req};	1727	delete $self->{size_req};
		1728	delete $self->{texture};
1636		1729
1637	$self->SUPER::reconfigure;	1730	$self->SUPER::reconfigure;
1638	}	1731	}
1639		1732
1640	sub _draw {	1733	sub _draw {
1641	my ($self) = @_;	1734	my ($self) = @_;
1642		1735
1643	$self->SUPER::_draw; # draw background, if applicable	1736	$self->SUPER::_draw; # draw background, if applicable
1644		1737
1645	my $tex = $self->{texture} ||= do {	1738	my $size = $self->{texture} ||= do {
1646	$self->{layout}->set_foreground (@{$self->{fg}});	1739	$self->{layout}->set_foreground (@{$self->{fg}});
1647	$self->{layout}->set_font ($self->{font}) if $self->{font};	1740	$self->{layout}->set_font ($self->{font}) if $self->{font};
1648	$self->{layout}->set_width ($self->{w});	1741	$self->{layout}->set_width ($self->{w});
1649	$self->{layout}->set_ellipsise ($self->{ellipsise});	1742	$self->{layout}->set_ellipsise ($self->{ellipsise});
1650	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1743	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1651	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1744	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1652		1745
1653	new_from_layout CFClient::Texture $self->{layout}	1746	[$self->{layout}->size]
1654	};	1747	};
1655		1748
1656	unless (exists $self->{ox}) {	1749	unless (exists $self->{ox}) {
1657	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1750	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1658	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1751	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1659	: ($self->{w} - $tex->{w}) * 0.5);	1752	: ($self->{w} - $size->[0]) * 0.5);
1660		1753
1661	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1754	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1662	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1755	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1663	: ($self->{h} - $tex->{h}) * 0.5);	1756	: ($self->{h} - $size->[1]) * 0.5);
1664	};	1757	};
1665		1758
1666	glEnable GL_TEXTURE_2D;
1667
1668	my $w = List::Util::min $self->{w} + 4, $tex->{w};	1759	my $w = List::Util::min $self->{w} + 4, $size->[0];
1669	my $h = List::Util::min $self->{h} + 2, $tex->{h};	1760	my $h = List::Util::min $self->{h} + 2, $size->[1];
1670		1761
1671	if ($tex->{format} == GL_ALPHA) {	1762	$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	}	1763	}
1682		1764
1683	#############################################################################	1765	#############################################################################
1684		1766
1685	package CFClient::UI::EntryBase;	1767	package CFClient::UI::EntryBase;
…		…
1718		1800
1719	$text =~ s/./*/g if $self->{hidden};	1801	$text =~ s/./*/g if $self->{hidden};
1720	$self->{layout}->set_text ("$text ");	1802	$self->{layout}->set_text ("$text ");
1721	delete $self->{size_req};	1803	delete $self->{size_req};
1722		1804
1723	$self->_emit (changed => $self->{text});	1805	$self->emit (changed => $self->{text});
1724		1806
1725	$self->realloc;	1807	$self->realloc;
1726	$self->update;	1808	$self->update;
1727	}	1809	}
1728		1810
…		…
1743	my ($w, $h) = $self->SUPER::size_request;	1825	my ($w, $h) = $self->SUPER::size_request;
1744		1826
1745	($w + 1, $h) # add 1 for cursor	1827	($w + 1, $h) # add 1 for cursor
1746	}	1828	}
1747		1829
1748	sub key_down {	1830	sub invoke_key_down {
1749	my ($self, $ev) = @_;	1831	my ($self, $ev) = @_;
1750		1832
1751	my $mod = $ev->{mod};	1833	my $mod = $ev->{mod};
1752	my $sym = $ev->{sym};	1834	my $sym = $ev->{sym};
1753	my $uni = $ev->{unicode};	1835	my $uni = $ev->{unicode};
…		…
1765	} elsif ($sym == CFClient::SDLK_HOME) {	1847	} elsif ($sym == CFClient::SDLK_HOME) {
1766	$self->{cursor} = 0;	1848	$self->{cursor} = 0;
1767	} elsif ($sym == CFClient::SDLK_END) {	1849	} elsif ($sym == CFClient::SDLK_END) {
1768	$self->{cursor} = length $text;	1850	$self->{cursor} = length $text;
1769	} elsif ($uni == 27) {	1851	} elsif ($uni == 27) {
1770	$self->_emit ('escape');	1852	$self->emit ('escape');
1771	} elsif ($uni) {	1853	} elsif ($uni) {
1772	substr $text, $self->{cursor}++, 0, chr $uni;	1854	substr $text, $self->{cursor}++, 0, chr $uni;
1773	} else {	1855	} else {
1774	return 0;	1856	return 0;
1775	}	1857	}
…		…
1779	$self->realloc;	1861	$self->realloc;
1780		1862
1781	1	1863	1
1782	}	1864	}
1783		1865
1784	sub focus_in {	1866	sub invoke_focus_in {
1785	my ($self) = @_;	1867	my ($self) = @_;
1786		1868
1787	$self->{last_activity} = $::NOW;	1869	$self->{last_activity} = $::NOW;
1788		1870
1789	$self->SUPER::focus_in;	1871	$self->SUPER::invoke_focus_in
1790	}	1872	}
1791		1873
1792	sub button_down {	1874	sub invoke_button_down {
1793	my ($self, $ev, $x, $y) = @_;	1875	my ($self, $ev, $x, $y) = @_;
1794		1876
1795	$self->SUPER::button_down ($ev, $x, $y);	1877	$self->SUPER::invoke_button_down ($ev, $x, $y);
1796		1878
1797	my $idx = $self->{layout}->xy_to_index ($x, $y);	1879	my $idx = $self->{layout}->xy_to_index ($x, $y);
1798		1880
1799	# byte-index to char-index	1881	# byte-index to char-index
1800	my $text = $self->{text};	1882	my $text = $self->{text};
1801	utf8::encode $text;	1883	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1802	$self->{cursor} = length substr $text, 0, $idx;	1884	$self->{cursor} = length $text;
1803		1885
1804	$self->_set_text ($self->{text});	1886	$self->_set_text ($self->{text});
1805	$self->update;	1887	$self->update;
1806		1888
1807	1	1889	1
1808	}	1890	}
1809		1891
1810	sub mouse_motion {	1892	sub invoke_mouse_motion {
1811	my ($self, $ev, $x, $y) = @_;	1893	my ($self, $ev, $x, $y) = @_;
1812	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1894	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1813		1895
1814	0	1896	1
1815	}	1897	}
1816		1898
1817	sub _draw {	1899	sub _draw {
1818	my ($self) = @_;	1900	my ($self) = @_;
1819		1901
…		…
1860		1942
1861	our @ISA = CFClient::UI::EntryBase::;	1943	our @ISA = CFClient::UI::EntryBase::;
1862		1944
1863	use CFClient::OpenGL;	1945	use CFClient::OpenGL;
1864		1946
1865	sub key_down {	1947	sub invoke_key_down {
1866	my ($self, $ev) = @_;	1948	my ($self, $ev) = @_;
1867		1949
1868	my $sym = $ev->{sym};	1950	my $sym = $ev->{sym};
1869		1951
1870	if ($sym == 13) {	1952	if ($sym == 13) {
1871	unshift @{$self->{history}},	1953	unshift @{$self->{history}},
1872	my $txt = $self->get_text;	1954	my $txt = $self->get_text;
		1955
1873	$self->{history_pointer} = -1;	1956	$self->{history_pointer} = -1;
1874	$self->{history_saveback} = '';	1957	$self->{history_saveback} = '';
1875	$self->_emit (activate => $txt);	1958	$self->emit (activate => $txt);
1876	$self->update;	1959	$self->update;
1877		1960
1878	} elsif ($sym == CFClient::SDLK_UP) {	1961	} elsif ($sym == CFClient::SDLK_UP) {
1879	if ($self->{history_pointer} < 0) {	1962	if ($self->{history_pointer} < 0) {
1880	$self->{history_saveback} = $self->get_text;	1963	$self->{history_saveback} = $self->get_text;
…		…
1896	} else {	1979	} else {
1897	$self->set_text ($self->{history_saveback});	1980	$self->set_text ($self->{history_saveback});
1898	}	1981	}
1899		1982
1900	} else {	1983	} else {
1901	return $self->SUPER::key_down ($ev)	1984	return $self->SUPER::invoke_key_down ($ev)
1902	}	1985	}
1903		1986
1904	1	1987	1
1905	}	1988	}
1906		1989
…		…
1930	can_events => 1,	2013	can_events => 1,
1931	@_	2014	@_
1932	)	2015	)
1933	}	2016	}
1934		2017
1935	sub activate { }
1936
1937	sub button_up {	2018	sub invoke_button_up {
1938	my ($self, $ev, $x, $y) = @_;	2019	my ($self, $ev, $x, $y) = @_;
1939		2020
1940	$self->emit ("activate")	2021	$self->emit ("activate")
1941	if $x >= 0 && $x < $self->{w}	2022	if $x >= 0 && $x < $self->{w}
1942	&& $y >= 0 && $y < $self->{h};	2023	&& $y >= 0 && $y < $self->{h};
…		…
1956	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2037	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1957		2038
1958	glDisable GL_TEXTURE_2D;	2039	glDisable GL_TEXTURE_2D;
1959		2040
1960	$self->SUPER::_draw;	2041	$self->SUPER::_draw;
		2042	}
		2043
		2044	#############################################################################
		2045
		2046	package CFClient::UI::ImageButton;
		2047
		2048	our @ISA = CFClient::UI::Image::;
		2049
		2050	use CFClient::OpenGL;
		2051
		2052	my %textures;
		2053
		2054	sub new {
		2055	my $class = shift;
		2056
		2057	my $self = $class->SUPER::new (
		2058	padding_x => 4,
		2059	padding_y => 4,
		2060	fg => [1, 1, 1],
		2061	active_fg => [0, 0, 1],
		2062	can_hover => 1,
		2063	align => 0,
		2064	valign => 0,
		2065	can_events => 1,
		2066	@_
		2067	);
		2068	}
		2069
		2070	sub invoke_button_up {
		2071	my ($self, $ev, $x, $y) = @_;
		2072
		2073	$self->emit ("activate")
		2074	if $x >= 0 && $x < $self->{w}
		2075	&& $y >= 0 && $y < $self->{h};
		2076
		2077	1
1961	}	2078	}
1962		2079
1963	#############################################################################	2080	#############################################################################
1964		2081
1965	package CFClient::UI::CheckBox;	2082	package CFClient::UI::CheckBox;
…		…
1992	my ($self) = @_;	2109	my ($self) = @_;
1993		2110
1994	(6) x 2	2111	(6) x 2
1995	}	2112	}
1996		2113
		2114	sub toggle {
		2115	my ($self) = @_;
		2116
		2117	$self->{state} = !$self->{state};
		2118	$self->emit (changed => $self->{state});
		2119	$self->update;
		2120	}
		2121
1997	sub button_down {	2122	sub invoke_button_down {
1998	my ($self, $ev, $x, $y) = @_;	2123	my ($self, $ev, $x, $y) = @_;
1999		2124
2000	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2125	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2001	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2126	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2002	$self->{state} = !$self->{state};	2127	$self->toggle;
2003	$self->_emit (changed => $self->{state});
2004	} else {	2128	} else {
2005	return 0	2129	return 0
2006	}	2130	}
2007		2131
2008	1	2132	1
…		…
2033	package CFClient::UI::Image;	2157	package CFClient::UI::Image;
2034		2158
2035	our @ISA = CFClient::UI::Base::;	2159	our @ISA = CFClient::UI::Base::;
2036		2160
2037	use CFClient::OpenGL;	2161	use CFClient::OpenGL;
2038	use Carp qw/confess/;
2039		2162
2040	our %loaded_images;	2163	our %texture_cache;
2041		2164
2042	sub new {	2165	sub new {
2043	my $class = shift;	2166	my $class = shift;
2044		2167
2045	my $self = $class->SUPER::new (can_events => 0, @_);	2168	my $self = $class->SUPER::new (
		2169	can_events => 0,
		2170	@_,
		2171	);
2046		2172
2047	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2173	$self->{path} || $self->{tex}
		2174	or Carp::croak "'path' or 'tex' attributes required";
2048		2175
2049	$loaded_images{$self->{image}} ||=	2176	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2050	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2177	new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2051		2178
2052	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2179	Scalar::Util::weaken $texture_cache{$self->{path}};
2053		2180
2054	Scalar::Util::weaken $loaded_images{$self->{image}};	2181	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2055
2056	$self->{aspect} = $tex->{w} / $tex->{h};
2057		2182
2058	$self	2183	$self
2059	}	2184	}
2060		2185
2061	sub size_request {	2186	sub size_request {
2062	my ($self) = @_;	2187	my ($self) = @_;
2063		2188
2064	($self->{tex}->{w}, $self->{tex}->{h})	2189	($self->{tex}{w}, $self->{tex}{h})
2065	}	2190	}
2066		2191
2067	sub _draw {	2192	sub _draw {
2068	my ($self) = @_;	2193	my ($self) = @_;
2069		2194
…		…
2178	my $ycut1 = max 0, min 1, $ycut;	2303	my $ycut1 = max 0, min 1, $ycut;
2179	my $ycut2 = max 0, min 1, $ycut - 1;	2304	my $ycut2 = max 0, min 1, $ycut - 1;
2180		2305
2181	my $h1 = $self->{h} * (1 - $ycut1);	2306	my $h1 = $self->{h} * (1 - $ycut1);
2182	my $h2 = $self->{h} * (1 - $ycut2);	2307	my $h2 = $self->{h} * (1 - $ycut2);
		2308	my $h3 = $self->{h};
		2309
		2310	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2183		2311
2184	glEnable GL_BLEND;	2312	glEnable GL_BLEND;
2185	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2313	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2186	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2314	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2187	glEnable GL_TEXTURE_2D;	2315	glEnable GL_TEXTURE_2D;
…		…
2206		2334
2207	if ($t3) {	2335	if ($t3) {
2208	glBindTexture GL_TEXTURE_2D, $t3->{name};	2336	glBindTexture GL_TEXTURE_2D, $t3->{name};
2209	glBegin GL_QUADS;	2337	glBegin GL_QUADS;
2210	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2338	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2211	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2339	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2212	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2340	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2213	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2341	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2214	glEnd;	2342	glEnd;
2215	}	2343	}
2216		2344
2217	glDisable GL_BLEND;	2345	glDisable GL_BLEND;
…		…
2305	$self->update;	2433	$self->update;
2306		2434
2307	$self	2435	$self
2308	}	2436	}
2309		2437
2310	sub changed { }
2311
2312	sub set_range {	2438	sub set_range {
2313	my ($self, $range) = @_;	2439	my ($self, $range) = @_;
2314		2440
2315	($range, $self->{range}) = ($self->{range}, $range);	2441	($range, $self->{range}) = ($self->{range}, $range);
2316		2442
…		…
2336	if $unit;	2462	if $unit;
2337		2463
2338	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2464	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2339		2465
2340	if ($value != $old_value) {	2466	if ($value != $old_value) {
2341	$self->_emit (changed => $value);	2467	$self->emit (changed => $value);
2342	$self->update;	2468	$self->update;
2343	}	2469	}
2344	}	2470	}
2345		2471
2346	sub size_request {	2472	sub size_request {
2347	my ($self) = @_;	2473	my ($self) = @_;
2348		2474
2349	($self->{req_w}, $self->{req_h})	2475	($self->{req_w}, $self->{req_h})
2350	}	2476	}
2351		2477
2352	sub button_down {	2478	sub invoke_button_down {
2353	my ($self, $ev, $x, $y) = @_;	2479	my ($self, $ev, $x, $y) = @_;
2354		2480
2355	$self->SUPER::button_down ($ev, $x, $y);	2481	$self->SUPER::invoke_button_down ($ev, $x, $y);
2356		2482
2357	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2483	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2358		2484
2359	$self->mouse_motion ($ev, $x, $y)	2485	$self->invoke_mouse_motion ($ev, $x, $y)
2360	}	2486	}
2361		2487
2362	sub mouse_motion {	2488	sub invoke_mouse_motion {
2363	my ($self, $ev, $x, $y) = @_;	2489	my ($self, $ev, $x, $y) = @_;
2364		2490
2365	if ($GRAB == $self) {	2491	if ($GRAB == $self) {
2366	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2492	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2367		2493
…		…
2373	} else {	2499	} else {
2374	return 0;	2500	return 0;
2375	}	2501	}
2376		2502
2377	1	2503	1
		2504	}
		2505
		2506	sub invoke_mouse_wheel {
		2507	my ($self, $ev) = @_;
		2508
		2509	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2510
		2511	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.1);
		2512
		2513	! ! $delta
2378	}	2514	}
2379		2515
2380	sub update {	2516	sub update {
2381	my ($self) = @_;	2517	my ($self) = @_;
2382		2518
…		…
2483	sub new {	2619	sub new {
2484	my $class = shift;	2620	my $class = shift;
2485		2621
2486	my $self = $class->SUPER::new (	2622	my $self = $class->SUPER::new (
2487	fontsize => 1,	2623	fontsize => 1,
2488	can_events => 0,	2624	can_events => 1,
2489	indent => 0,	2625	indent => 0,
2490	#font => default_font	2626	#font => default_font
2491	@_,	2627	@_,
2492		2628
2493	layout => (new CFClient::Layout 1),	2629	layout => (new CFClient::Layout),
2494	par => [],	2630	par => [],
2495	height => 0,	2631	height => 0,
2496	children => [	2632	children => [
2497	(new CFClient::UI::Empty expand => 1),	2633	(new CFClient::UI::Empty expand => 1),
2498	(new CFClient::UI::Slider vertical => 1),	2634	(new CFClient::UI::Slider vertical => 1),
…		…
2509		2645
2510	$self->{fontsize} = $fontsize;	2646	$self->{fontsize} = $fontsize;
2511	$self->reflow;	2647	$self->reflow;
2512	}	2648	}
2513		2649
		2650	sub size_request {
		2651	my ($self) = @_;
		2652
		2653	my ($empty, $slider) = @{ $self->{children} };
		2654
		2655	local $self->{children} = [$empty, $slider];
		2656	$self->SUPER::size_request
		2657	}
		2658
2514	sub size_allocate {	2659	sub invoke_size_allocate {
2515	my ($self, $w, $h) = @_;	2660	my ($self, $w, $h) = @_;
2516		2661
2517	$self->SUPER::size_allocate ($w, $h);	2662	my ($empty, $slider, @other) = @{ $self->{children} };
		2663	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2518		2664
2519	$self->{layout}->set_font ($self->{font}) if $self->{font};	2665	$self->{layout}->set_font ($self->{font}) if $self->{font};
2520	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2666	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2521	$self->{layout}->set_width ($self->{children}[0]{w});	2667	$self->{layout}->set_width ($empty->{w});
2522	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2668	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2523		2669
2524	$self->reflow;	2670	$self->reflow;
2525	}
2526		2671
2527	sub text_size {	2672	local $self->{children} = [$empty, $slider];
		2673	$self->SUPER::invoke_size_allocate ($w, $h)
		2674	}
		2675
		2676	sub invoke_mouse_wheel {
2528	my ($self, $text, $indent) = @_;	2677	my ($self, $ev) = @_;
		2678
		2679	return 0 unless $ev->{dy}; # only vertical movements
		2680
		2681	$self->{children}[1]->emit (mouse_wheel => $ev);
		2682
		2683	1
		2684	}
		2685
		2686	sub get_layout {
		2687	my ($self, $para) = @_;
2529		2688
2530	my $layout = $self->{layout};	2689	my $layout = $self->{layout};
2531		2690
		2691	$layout->set_font ($self->{font}) if $self->{font};
		2692	$layout->set_foreground (@{$para->{fg}});
2532	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2693	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2533	$layout->set_width ($self->{children}[0]{w} - $indent);	2694	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2534	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2695	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2535	$layout->set_markup ($text);	2696	$layout->set_markup ($para->{markup});
		2697
		2698	$layout->set_shapes (
		2699	map
		2700	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		2701	@{$para->{widget}}
2536		2702	);
		2703
2537	$layout->size	2704	$layout
2538	}	2705	}
2539		2706
2540	sub reflow {	2707	sub reflow {
2541	my ($self) = @_;	2708	my ($self) = @_;
2542		2709
…		…
2551	$self->{children}[1]->set_value ($offset);	2718	$self->{children}[1]->set_value ($offset);
2552	}	2719	}
2553		2720
2554	sub clear {	2721	sub clear {
2555	my ($self) = @_;	2722	my ($self) = @_;
		2723
		2724	my (undef, undef, @other) = @{ $self->{children} };
		2725	$self->remove ($_) for @other;
2556		2726
2557	$self->{par} = [];	2727	$self->{par} = [];
2558	$self->{height} = 0;	2728	$self->{height} = 0;
2559	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2729	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2560	}	2730	}
2561		2731
2562	sub add_paragraph {	2732	sub add_paragraph {
2563	my ($self, $color, $text, $indent) = @_;	2733	my ($self, $color, $para, $indent) = @_;
2564		2734
2565	for my $line (split /\n/, $text) {	2735	my ($text, @w) = ref $para ? @$para : $para;
2566	my ($w, $h) = $self->text_size ($line);	2736
2567	$self->{height} += $h;	2737	$para = {
2568	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	2738	w => 1e10,
		2739	wrapped => 1,
		2740	fg => $color,
		2741	indent => $indent,
		2742	markup => $text,
		2743	widget => \@w,
2569	}	2744	};
2570		2745
2571	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	2746	$self->add (@w) if @w;
		2747	push @{$self->{par}}, $para;
		2748
		2749	$self->{need_reflow}++;
		2750	$self->update;
		2751	}
		2752
		2753	sub scroll_to_bottom {
		2754	my ($self) = @_;
		2755
		2756	$self->{scroll_to_bottom} = 1;
		2757	$self->update;
2572	}	2758	}
2573		2759
2574	sub update {	2760	sub update {
2575	my ($self) = @_;	2761	my ($self) = @_;
2576		2762
…		…
2584	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2770	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2585		2771
2586	if (delete $self->{need_reflow}) {	2772	if (delete $self->{need_reflow}) {
2587	my $height = 0;	2773	my $height = 0;
2588		2774
2589	my $layout = $self->{layout};
2590
2591	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2592
2593	for (@{$self->{par}}) {	2775	for my $para (@{$self->{par}}) {
2594	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2776	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2595	$layout->set_width ($W - $_->[3]);	2777	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;	2778	my ($w, $h) = $layout->size;
2599	$_->[0] = $w + $_->[3];	2779
2600	$_->[1] = $h;	2780	$para->{w} = $w + $para->{indent};
		2781	$para->{h} = $h;
		2782	$para->{wrapped} = $layout->has_wrapped;
2601	}	2783	}
2602		2784
2603	$height += $_->[1];	2785	$height += $para->{h};
2604	}	2786	}
2605		2787
2606	$self->{height} = $height;	2788	$self->{height} = $height;
2607		2789
2608	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2790	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2609		2791
2610	delete $self->{texture};	2792	delete $self->{texture};
		2793	}
		2794
		2795	if (delete $self->{scroll_to_bottom}) {
		2796	$self->{children}[1]->set_value (1e10);
2611	}	2797	}
2612		2798
2613	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2799	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2614	glClearColor 0, 0, 0, 0;	2800	glClearColor 0, 0, 0, 0;
2615	glClear GL_COLOR_BUFFER_BIT;	2801	glClear GL_COLOR_BUFFER_BIT;
…		…
2619	my $y0 = $top;	2805	my $y0 = $top;
2620	my $y1 = $top + $H;	2806	my $y1 = $top + $H;
2621		2807
2622	my $y = 0;	2808	my $y = 0;
2623		2809
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}}) {	2810	for my $para (@{$self->{par}}) {
2633	my $h = $par->[1];	2811	my $h = $para->{h};
2634		2812
2635	if ($y0 < $y + $h && $y < $y1) {	2813	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		2814
2641	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2815	my $layout = $self->get_layout ($para);
2642		2816
2643	glRasterPos $par->[3], $y - $y0;	2817	$layout->render ($para->{indent}, $y - $y0);
2644	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	2818
		2819	if (my @w = @{ $para->{widget} }) {
		2820	my @s = $layout->get_shapes;
		2821
		2822	for (@w) {
		2823	my ($dx, $dy) = splice @s, 0, 2, ();
		2824
		2825	$_->{x} = $dx + $para->{indent};
		2826	$_->{y} = $dy + $y - $y0;
		2827
		2828	$_->draw;
		2829	}
		2830	}
2645	}	2831	}
2646		2832
2647	$y += $h;	2833	$y += $h;
2648	}	2834	}
2649
2650	glDisable GL_BLEND;
2651	};	2835	};
2652	});	2836	});
		2837	}
		2838
		2839	sub reconfigure {
		2840	my ($self) = @_;
		2841
		2842	$self->SUPER::reconfigure;
		2843
		2844	$_->{w} = 1e10 for @{ $self->{par} };
		2845	$self->reflow;
2653	}	2846	}
2654		2847
2655	sub _draw {	2848	sub _draw {
2656	my ($self) = @_;	2849	my ($self) = @_;
2657		2850
…		…
2660	glColor 0, 0, 0, 1;	2853	glColor 0, 0, 0, 1;
2661	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2854	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2662	glDisable GL_TEXTURE_2D;	2855	glDisable GL_TEXTURE_2D;
2663		2856
2664	$self->{children}[1]->draw;	2857	$self->{children}[1]->draw;
2665
2666	}	2858	}
2667		2859
2668	#############################################################################	2860	#############################################################################
2669		2861
2670	package CFClient::UI::Animator;	2862	package CFClient::UI::Animator;
…		…
2779	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2971	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2780		2972
2781	($w + 4, $h + 4)	2973	($w + 4, $h + 4)
2782	}	2974	}
2783		2975
2784	sub size_allocate {	2976	sub invoke_size_allocate {
2785	my ($self, $w, $h) = @_;	2977	my ($self, $w, $h) = @_;
2786		2978
2787	$self->SUPER::size_allocate ($w - 4, $h - 4);	2979	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2788	}	2980	}
2789		2981
2790	sub visibility_change {	2982	sub invoke_visibility_change {
2791	my ($self, $visible) = @_;	2983	my ($self, $visible) = @_;
2792		2984
2793	return unless $visible;	2985	return unless $visible;
2794		2986
2795	$self->{root}->on_post_alloc ("move_$self" => sub {	2987	$self->{root}->on_post_alloc ("move_$self" => sub {
…		…
2943	for my $item (@{ $self->{items} }) {	3135	for my $item (@{ $self->{items} }) {
2944	my ($widget, $cb, $tooltip) = @$item;	3136	my ($widget, $cb, $tooltip) = @$item;
2945		3137
2946	# handle various types of items, only text for now	3138	# handle various types of items, only text for now
2947	if (!ref $widget) {	3139	if (!ref $widget) {
		3140	if ($widget =~ /\t/) {
		3141	my ($left, $right) = split /\t/, $widget, 2;
		3142
		3143	$widget = new CFClient::UI::HBox
		3144	can_hover => 1,
		3145	can_events => 1,
		3146	tooltip => $tooltip,
		3147	children => [
		3148	(new CFClient::UI::Label markup => $left, expand => 1),
		3149	(new CFClient::UI::Label markup => $right, align => +1),
		3150	],
		3151	;
		3152
		3153	} else {
2948	$widget = new CFClient::UI::Label	3154	$widget = new CFClient::UI::Label
2949	can_hover => 1,	3155	can_hover => 1,
2950	can_events => 1,	3156	can_events => 1,
2951	markup => $widget,	3157	markup => $widget,
2952	tooltip => $tooltip	3158	tooltip => $tooltip;
		3159	}
2953	}	3160	}
2954		3161
2955	$self->{item}{$widget} = $item;	3162	$self->{item}{$widget} = $item;
2956		3163
2957	$self->{vbox}->add ($widget);	3164	$self->{vbox}->add ($widget);
…		…
2962		3169
2963	# popup given the event (must be a mouse button down event currently)	3170	# popup given the event (must be a mouse button down event currently)
2964	sub popup {	3171	sub popup {
2965	my ($self, $ev) = @_;	3172	my ($self, $ev) = @_;
2966		3173
2967	$self->_emit ("popdown");	3174	$self->emit ("popdown");
2968		3175
2969	# maybe save $GRAB? must be careful about events...	3176	# maybe save $GRAB? must be careful about events...
2970	$GRAB = $self;	3177	$GRAB = $self;
2971	$self->{button} = $ev->{button};	3178	$self->{button} = $ev->{button};
2972		3179
2973	$self->show;	3180	$self->show;
2974	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3181	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2975	}	3182	}
2976		3183
2977	sub mouse_motion {	3184	sub invoke_mouse_motion {
2978	my ($self, $ev, $x, $y) = @_;	3185	my ($self, $ev, $x, $y) = @_;
2979		3186
2980	# TODO: should use vbox->find_widget or so	3187	# TODO: should use vbox->find_widget or so
2981	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3188	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2982	$self->{hover} = $self->{item}{$HOVER};	3189	$self->{hover} = $self->{item}{$HOVER};
2983		3190
2984	0	3191	0
2985	}	3192	}
2986		3193
2987	sub button_up {	3194	sub invoke_button_up {
2988	my ($self, $ev, $x, $y) = @_;	3195	my ($self, $ev, $x, $y) = @_;
2989		3196
2990	if ($ev->{button} == $self->{button}) {	3197	if ($ev->{button} == $self->{button}) {
2991	undef $GRAB;	3198	undef $GRAB;
2992	$self->hide;	3199	$self->hide;
2993		3200
2994	$self->_emit ("popdown");	3201	$self->emit ("popdown");
2995	$self->{hover}[1]->() if $self->{hover};	3202	$self->{hover}[1]->() if $self->{hover};
2996	} else {	3203	} else {
2997	return 0	3204	return 0
2998	}	3205	}
2999		3206
…		…
3026		3233
3027	$self->{current} = $self->{children}[0]	3234	$self->{current} = $self->{children}[0]
3028	if @{ $self->{children} };	3235	if @{ $self->{children} };
3029	}	3236	}
3030		3237
		3238	sub get_current_page {
		3239	my ($self) = @_;
		3240
		3241	$self->{current}
		3242	}
		3243
3031	sub set_current_page {	3244	sub set_current_page {
3032	my ($self, $page_or_widget) = @_;	3245	my ($self, $page_or_widget) = @_;
3033		3246
3034	my $widget = ref $page_or_widget	3247	my $widget = ref $page_or_widget
3035	? $page_or_widget	3248	? $page_or_widget
3036	: $self->{children}[$page_or_widget];	3249	: $self->{children}[$page_or_widget];
3037		3250
3038	$self->{current} = $widget;	3251	$self->{current} = $widget;
3039	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3252	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3040		3253
3041	$self->_emit (page_changed => $self->{current});	3254	$self->emit (page_changed => $self->{current});
3042		3255
3043	$self->realloc;	3256	$self->realloc;
3044	}	3257	}
3045		3258
3046	sub visible_children {	3259	sub visible_children {
…		…
3051	my ($self) = @_;	3264	my ($self) = @_;
3052		3265
3053	$self->{current}->size_request	3266	$self->{current}->size_request
3054	}	3267	}
3055		3268
3056	sub size_allocate {	3269	sub invoke_size_allocate {
3057	my ($self, $w, $h) = @_;	3270	my ($self, $w, $h) = @_;
3058		3271
3059	$self->{current}->configure (0, 0, $w, $h);	3272	$self->{current}->configure (0, 0, $w, $h);
		3273
		3274	1
3060	}	3275	}
3061		3276
3062	sub _draw {	3277	sub _draw {
3063	my ($self) = @_;	3278	my ($self) = @_;
3064		3279
…		…
3099	);	3314	);
3100		3315
3101	$self->{multiplexer}->add ($widget);	3316	$self->{multiplexer}->add ($widget);
3102	}	3317	}
3103		3318
		3319	sub get_current_page {
		3320	my ($self) = @_;
		3321
		3322	$self->{multiplexer}->get_current_page
		3323	}
		3324
3104	sub set_current_page {	3325	sub set_current_page {
3105	my ($self, $page) = @_;	3326	my ($self, $page) = @_;
3106		3327
3107	$self->{multiplexer}->set_current_page ($page);	3328	$self->{multiplexer}->set_current_page ($page);
3108	$self->_emit (page_changed => $self->{multiplexer}{current});	3329	$self->emit (page_changed => $self->{multiplexer}{current});
3109	}	3330	}
3110		3331
3111	#############################################################################	3332	#############################################################################
3112		3333
3113	package CFClient::UI::Combobox;	3334	package CFClient::UI::Combobox;
…		…
3128	$self->_set_value ($self->{value});	3349	$self->_set_value ($self->{value});
3129		3350
3130	$self	3351	$self
3131	}	3352	}
3132		3353
3133	sub button_down {	3354	sub invoke_button_down {
3134	my ($self, $ev) = @_;	3355	my ($self, $ev) = @_;
3135		3356
3136	my @menu_items;	3357	my @menu_items;
3137		3358
3138	for (@{ $self->{options} }) {	3359	for (@{ $self->{options} }) {
…		…
3159	my ($self, $value) = @_;	3380	my ($self, $value) = @_;
3160		3381
3161	return unless $self->{value} ne $value;	3382	return unless $self->{value} ne $value;
3162		3383
3163	$self->_set_value ($value);	3384	$self->_set_value ($value);
3164	$self->_emit (changed => $value);	3385	$self->emit (changed => $value);
3165	}	3386	}
3166		3387
3167	#############################################################################	3388	#############################################################################
3168		3389
3169	package CFClient::UI::Statusbox;	3390	package CFClient::UI::Statusbox;
…		…
3284	count => 1,	3505	count => 1,
3285	%arg,	3506	%arg,
3286	};	3507	};
3287	}	3508	}
3288		3509
		3510	$ROOT->on_refresh (reorder => sub {
3289	$self->reorder;	3511	$self->reorder;
		3512	});
3290	}	3513	}
3291		3514
3292	sub reconfigure {	3515	sub reconfigure {
3293	my ($self) = @_;	3516	my ($self) = @_;
3294		3517
…		…
3309		3532
3310	#############################################################################	3533	#############################################################################
3311		3534
3312	package CFClient::UI::Inventory;	3535	package CFClient::UI::Inventory;
3313		3536
3314	our @ISA = CFClient::UI::ScrolledWindow::;	3537	our @ISA = CFClient::UI::Table::;
3315		3538
3316	sub new {	3539	sub new {
3317	my $class = shift;	3540	my $class = shift;
3318		3541
3319	my $self = $class->SUPER::new (	3542	my $self = $class->SUPER::new (
3320	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),	3543	col_expand => [0, 1, 0],
3321	@_,	3544	@_,
3322	);	3545	);
3323		3546
3324	$self	3547	$self
3325	}	3548	}
3326		3549
3327	sub set_items {	3550	sub set_items {
3328	my ($self, $items) = @_;	3551	my ($self, $items) = @_;
3329		3552
3330	$self->{child}->clear;	3553	$self->clear;
3331	return unless $items;	3554	return unless $items;
3332		3555
3333	my @items = sort {	3556	my @items = sort {
3334	($a->{type} <=> $b->{type})	3557	($a->{type} <=> $b->{type})
3335	or ($a->{name} cmp $b->{name})	3558	or ($a->{name} cmp $b->{name})
3336	} @$items;	3559	} values %$items;
3337		3560
3338	$self->{real_items} = \@items;	3561	$self->{real_items} = \@items;
3339		3562
3340	my $row = 0;	3563	my $row = 0;
3341	for my $item (@items) {	3564	for my $item (@items) {
3342	CFClient::Item::update_widgets $item;	3565	CFClient::Item::update_widgets $item;
3343		3566
3344	$self->{child}->add (0, $row, $item->{face_widget});	3567	$self->add (0, $row, $item->{face_widget});
3345	$self->{child}->add (1, $row, $item->{desc_widget});	3568	$self->add (1, $row, $item->{desc_widget});
3346	$self->{child}->add (2, $row, $item->{weight_widget});	3569	$self->add (2, $row, $item->{weight_widget});
3347		3570
3348	$row++;	3571	$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	}	3572	}
3547	}	3573	}
3548		3574
3549	#############################################################################	3575	#############################################################################
3550		3576
…		…
3604	} elsif ($ev->{button} == 2) {	3630	} elsif ($ev->{button} == 2) {
3605	$::CONN->user_send ("invoke $spell->{name}");	3631	$::CONN->user_send ("invoke $spell->{name}");
3606	} elsif ($ev->{button} == 3) {	3632	} elsif ($ev->{button} == 3) {
3607	(new CFClient::UI::Menu	3633	(new CFClient::UI::Menu
3608	items => [	3634	items => [
3609	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],	3635	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3610	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],	3636	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3611	],	3637	],
3612	)->popup ($ev);	3638	)->popup ($ev);
3613	} else {	3639	} else {
3614	return 0;	3640	return 0;
…		…
3709	$coord = $max - $size if $coord > $max - $size;	3735	$coord = $max - $size if $coord > $max - $size;
3710		3736
3711	int $coord + 0.5	3737	int $coord + 0.5
3712	}	3738	}
3713		3739
3714	sub size_allocate {	3740	sub invoke_size_allocate {
3715	my ($self, $w, $h) = @_;	3741	my ($self, $w, $h) = @_;
3716		3742
3717	for my $child ($self->children) {	3743	for my $child ($self->children) {
3718	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3744	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3719		3745
…		…
3723	$X = _to_pixel $X, $W, $self->{w};	3749	$X = _to_pixel $X, $W, $self->{w};
3724	$Y = _to_pixel $Y, $H, $self->{h};	3750	$Y = _to_pixel $Y, $H, $self->{h};
3725		3751
3726	$child->configure ($X, $Y, $W, $H);	3752	$child->configure ($X, $Y, $W, $H);
3727	}	3753	}
		3754
		3755	1
3728	}	3756	}
3729		3757
3730	sub coord2local {	3758	sub coord2local {
3731	my ($self, $x, $y) = @_;	3759	my ($self, $x, $y) = @_;
3732		3760
…		…
3858	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3886	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3859		3887
3860	$w = 0 if $w < 0;	3888	$w = 0 if $w < 0;
3861	$h = 0 if $h < 0;	3889	$h = 0 if $h < 0;
3862		3890
		3891	$w = max $widget->{min_w}, $w;
		3892	$h = max $widget->{min_h}, $h;
		3893
		3894	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3895	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3896
3863	$w = int $w + 0.5;	3897	$w = int $w + 0.5;
3864	$h = int $h + 0.5;	3898	$h = int $h + 0.5;
3865		3899
3866	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	3900	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3867	$widget->{old_w} = $widget->{w};	3901	$widget->{old_w} = $widget->{w};

Diff Legend

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