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.303 by elmex, Tue Jun 13 10:28:38 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
1095	unless ($self->{no_close_button}) {	1149	if ($self->{has_close_button}) {
1096	$self->{close_btn} =	1150	$self->{close_button} =
1097	new CFClient::UI::ImageButton	1151	new CFClient::UI::ImageButton
1098	image => 'x1_close.png',	1152	path => 'x1_close.png',
1099	on_activate => sub { $self->hide };	1153	on_activate => sub { $self->emit ("delete") };
1100		1154
1101	$self->CFClient::UI::Container::add ($self->{close_btn});	1155	$self->CFClient::UI::Container::add ($self->{close_button});
1102	}	1156	}
1103		1157
1104	$self	1158	$self
1105	}	1159	}
1106		1160
1107	sub add {	1161	sub add {
1108	my ($self, @widgets) = @_;	1162	my ($self, @widgets) = @_;
1109		1163
1110	$self->SUPER::add (@widgets);	1164	$self->SUPER::add (@widgets);
1111	$self->CFClient::UI::Container::add ($self->{close_btn}) if $self->{close_btn};	1165	$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};	1166	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1113	}	1167	}
1114		1168
1115	sub border {	1169	sub border {
1116	int $_[0]{border} * $::FONTSIZE	1170	int $_[0]{border} * $::FONTSIZE
…		…
1120	my ($self) = @_;	1174	my ($self) = @_;
1121		1175
1122	$self->{title_widget}->size_request	1176	$self->{title_widget}->size_request
1123	if $self->{title_widget};	1177	if $self->{title_widget};
1124		1178
1125	$self->{close_btn}->size_request	1179	$self->{close_button}->size_request
1126	if $self->{close_btn};	1180	if $self->{close_button};
1127		1181
1128	my ($w, $h) = $self->SUPER::size_request;	1182	my ($w, $h) = $self->SUPER::size_request;
1129		1183
1130	(	1184	(
1131	$w + $self->border * 2,	1185	$w + $self->border * 2,
1132	$h + $self->border * 2,	1186	$h + $self->border * 2,
1133	)	1187	)
1134	}	1188	}
1135		1189
1136	sub size_allocate {	1190	sub invoke_size_allocate {
1137	my ($self, $w, $h) = @_;	1191	my ($self, $w, $h) = @_;
1138		1192
1139	if ($self->{title_widget}) {	1193	if ($self->{title_widget}) {
1140	$self->{title_widget}{w} = $w;	1194	$self->{title_widget}{w} = $w;
1141	$self->{title_widget}{h} = $h;	1195	$self->{title_widget}{h} = $h;
1142	$self->{title_widget}->size_allocate ($w, $h);	1196	$self->{title_widget}->invoke_size_allocate ($w, $h);
1143	}	1197	}
1144		1198
1145	my $border = $self->border;	1199	my $border = $self->border;
1146		1200
1147	$h -= List::Util::max 0, $border * 2;	1201	$h -= List::Util::max 0, $border * 2;
1148	$w -= List::Util::max 0, $border * 2;	1202	$w -= List::Util::max 0, $border * 2;
1149		1203
1150	$self->child->configure ($border, $border, $w, $h);	1204	$self->child->configure ($border, $border, $w, $h);
1151		1205
1152	$self->{close_btn}->configure ($self->{w} - (2 * $border), 0, $border, $border)	1206	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1153	if $self->{close_btn};	1207	if $self->{close_button};
1154	}
1155		1208
		1209	1
		1210	}
		1211
		1212	sub invoke_delete {
		1213	my ($self) = @_;
		1214
		1215	$self->hide;
		1216
		1217	1
		1218	}
		1219
1156	sub button_down {	1220	sub invoke_button_down {
1157	my ($self, $ev, $x, $y) = @_;	1221	my ($self, $ev, $x, $y) = @_;
1158		1222
1159	my ($w, $h) = @$self{qw(w h)};	1223	my ($w, $h) = @$self{qw(w h)};
1160	my $border = $self->border;	1224	my $border = $self->border;
1161		1225
…		…
1192		1256
1193	($x, $y) = ($ev->{x}, $ev->{y});	1257	($x, $y) = ($ev->{x}, $ev->{y});
1194		1258
1195	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1259	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1196	# HACK: the next line is required to enforce placement	1260	# HACK: the next line is required to enforce placement
1197	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1261	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1198	};	1262	};
1199	} else {	1263	} else {
1200	return 0;	1264	return 0;
1201	}	1265	}
1202		1266
1203	1	1267	1
1204	}	1268	}
1205		1269
1206	sub button_up {	1270	sub invoke_button_up {
1207	my ($self, $ev, $x, $y) = @_;	1271	my ($self, $ev, $x, $y) = @_;
1208		1272
1209	$self->{close_btn}->button_up ($ev, $x, $y)
1210	if $self->{close_btn};
1211
1212	!!delete $self->{motion}	1273	! ! delete $self->{motion}
1213	}	1274	}
1214		1275
1215	sub mouse_motion {	1276	sub invoke_mouse_motion {
1216	my ($self, $ev, $x, $y) = @_;	1277	my ($self, $ev, $x, $y) = @_;
1217		1278
1218	$self->{motion}->($ev, $x, $y) if $self->{motion};	1279	$self->{motion}->($ev, $x, $y) if $self->{motion};
1219		1280
1220	!!$self->{motion}	1281	! ! $self->{motion}
1221	}	1282	}
1222		1283
1223	sub _draw {	1284	sub _draw {
1224	my ($self) = @_;	1285	my ($self) = @_;
1225		1286
…		…
1258	$self->{title_widget}->_draw;	1319	$self->{title_widget}->_draw;
1259		1320
1260	glTranslate 0, - ($border - $self->{h});	1321	glTranslate 0, - ($border - $self->{h});
1261	}	1322	}
1262		1323
1263	$self->{close_btn}->draw	1324	$self->{close_button}->draw
1264	if $self->{close_btn};	1325	if $self->{close_button};
1265	}	1326	}
1266		1327
1267	#############################################################################	1328	#############################################################################
1268		1329
1269	package CFClient::UI::Table;	1330	package CFClient::UI::Table;
…		…
1348	(sum @$ws),	1409	(sum @$ws),
1349	(sum @$hs),	1410	(sum @$hs),
1350	)	1411	)
1351	}	1412	}
1352		1413
1353	sub size_allocate {	1414	sub invoke_size_allocate {
1354	my ($self, $w, $h) = @_;	1415	my ($self, $w, $h) = @_;
1355		1416
1356	my ($ws, $hs) = $self->get_wh;	1417	my ($ws, $hs) = $self->get_wh;
1357		1418
1358	my $req_w = (sum @$ws) || 1;	1419	my $req_w = (sum @$ws) || 1;
…		…
1390	}	1451	}
1391		1452
1392	$y += $row_h;	1453	$y += $row_h;
1393	}	1454	}
1394		1455
		1456	1
1395	}	1457	}
1396		1458
1397	sub find_widget {	1459	sub find_widget {
1398	my ($self, $x, $y) = @_;	1460	my ($self, $x, $y) = @_;
1399		1461
…		…
1436	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1498	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1437	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1499	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1438	)	1500	)
1439	}	1501	}
1440		1502
1441	sub size_allocate {	1503	sub invoke_size_allocate {
1442	my ($self, $w, $h) = @_;	1504	my ($self, $w, $h) = @_;
1443		1505
1444	my $space = $self->{vertical} ? $h : $w;	1506	my $space = $self->{vertical} ? $h : $w;
1445	my $children = $self->{children};	1507	my @children = $self->visible_children;
1446		1508
1447	my @req;	1509	my @req;
1448		1510
1449	if ($self->{homogeneous}) {	1511	if ($self->{homogeneous}) {
1450	@req = ($space / (@$children || 1)) x @$children;	1512	@req = ($space / (@children || 1)) x @children;
1451	} else {	1513	} else {
1452	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1514	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1453	my $req = List::Util::sum @req;	1515	my $req = List::Util::sum @req;
1454		1516
1455	if ($req > $space) {	1517	if ($req > $space) {
1456	# ah well, not enough space	1518	# ah well, not enough space
1457	$_ *= $space / $req for @req;	1519	$_ *= $space / $req for @req;
1458	} else {	1520	} else {
1459	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1521	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1460		1522
1461	$space = ($space - $req) / $expand; # remaining space to give away	1523	$space = ($space - $req) / $expand; # remaining space to give away
1462		1524
1463	$req[$_] += $space * $children->[$_]{expand}	1525	$req[$_] += $space * $children[$_]{expand}
1464	for 0 .. $#$children;	1526	for 0 .. $#children;
1465	}	1527	}
1466	}	1528	}
1467		1529
1468	CFClient::UI::harmonize \@req;	1530	CFClient::UI::harmonize \@req;
1469		1531
1470	my $pos = 0;	1532	my $pos = 0;
1471	for (0 .. $#$children) {	1533	for (0 .. $#children) {
1472	my $alloc = $req[$_];	1534	my $alloc = $req[$_];
1473	$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));
1474		1536
1475	$pos += $alloc;	1537	$pos += $alloc;
1476	}	1538	}
1477		1539
1478	1	1540	1
…		…
1581	my ($self, $text) = @_;	1643	my ($self, $text) = @_;
1582		1644
1583	return if $self->{text} eq "T$text";	1645	return if $self->{text} eq "T$text";
1584	$self->{text} = "T$text";	1646	$self->{text} = "T$text";
1585		1647
1586	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1587	$self->{layout}->set_text ($text);	1648	$self->{layout}->set_text ($text);
1588		1649
1589	delete $self->{size_req};	1650	delete $self->{size_req};
1590	$self->realloc;	1651	$self->realloc;
1591	$self->update;	1652	$self->update;
…		…
1597	return if $self->{text} eq "M$markup";	1658	return if $self->{text} eq "M$markup";
1598	$self->{text} = "M$markup";	1659	$self->{text} = "M$markup";
1599		1660
1600	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1661	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1601		1662
1602	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1603	$self->{layout}->set_markup ($markup);	1663	$self->{layout}->set_markup ($markup);
1604		1664
1605	delete $self->{size_req};	1665	delete $self->{size_req};
1606	$self->realloc;	1666	$self->realloc;
1607	$self->update;	1667	$self->update;
…		…
1619		1679
1620	my ($w, $h) = $self->{layout}->size;	1680	my ($w, $h) = $self->{layout}->size;
1621		1681
1622	if (exists $self->{template}) {	1682	if (exists $self->{template}) {
1623	$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);
1624	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1685	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1625		1686
1626	my ($w2, $h2) = $self->{template}->size;	1687	my ($w2, $h2) = $self->{template}->size;
1627		1688
1628	$w = List::Util::max $w, $w2;	1689	$w = List::Util::max $w, $w2;
…		…
1633	};	1694	};
1634		1695
1635	@{ $self->{size_req} }	1696	@{ $self->{size_req} }
1636	}	1697	}
1637		1698
		1699	sub baseline_shift {
		1700	$_[0]{layout}->descent
		1701	}
		1702
1638	sub size_allocate {	1703	sub invoke_size_allocate {
1639	my ($self, $w, $h) = @_;	1704	my ($self, $w, $h) = @_;
1640		1705
1641	delete $self->{ox};	1706	delete $self->{ox};
1642		1707
1643	delete $self->{texture}	1708	delete $self->{texture}
1644	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
1645	}	1712	}
1646		1713
1647	sub set_fontsize {	1714	sub set_fontsize {
1648	my ($self, $fontsize) = @_;	1715	my ($self, $fontsize) = @_;
1649		1716
1650	$self->{fontsize} = $fontsize;	1717	$self->{fontsize} = $fontsize;
		1718	delete $self->{size_req};
1651	delete $self->{texture};	1719	delete $self->{texture};
1652		1720
1653	$self->realloc;	1721	$self->realloc;
1654	}	1722	}
1655		1723
1656	sub reconfigure {	1724	sub reconfigure {
1657	my ($self) = @_;	1725	my ($self) = @_;
1658		1726
1659	delete $self->{size_req};	1727	delete $self->{size_req};
		1728	delete $self->{texture};
1660		1729
1661	$self->SUPER::reconfigure;	1730	$self->SUPER::reconfigure;
1662	}	1731	}
1663		1732
1664	sub _draw {	1733	sub _draw {
1665	my ($self) = @_;	1734	my ($self) = @_;
1666		1735
1667	$self->SUPER::_draw; # draw background, if applicable	1736	$self->SUPER::_draw; # draw background, if applicable
1668		1737
1669	my $tex = $self->{texture} ||= do {	1738	my $size = $self->{texture} ||= do {
1670	$self->{layout}->set_foreground (@{$self->{fg}});	1739	$self->{layout}->set_foreground (@{$self->{fg}});
1671	$self->{layout}->set_font ($self->{font}) if $self->{font};	1740	$self->{layout}->set_font ($self->{font}) if $self->{font};
1672	$self->{layout}->set_width ($self->{w});	1741	$self->{layout}->set_width ($self->{w});
1673	$self->{layout}->set_ellipsise ($self->{ellipsise});	1742	$self->{layout}->set_ellipsise ($self->{ellipsise});
1674	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1743	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1675	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1744	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1676		1745
1677	new_from_layout CFClient::Texture $self->{layout}	1746	[$self->{layout}->size]
1678	};	1747	};
1679		1748
1680	unless (exists $self->{ox}) {	1749	unless (exists $self->{ox}) {
1681	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1750	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1682	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1751	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1683	: ($self->{w} - $tex->{w}) * 0.5);	1752	: ($self->{w} - $size->[0]) * 0.5);
1684		1753
1685	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1754	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1686	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1755	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1687	: ($self->{h} - $tex->{h}) * 0.5);	1756	: ($self->{h} - $size->[1]) * 0.5);
1688	};	1757	};
1689		1758
1690	glEnable GL_TEXTURE_2D;
1691
1692	my $w = List::Util::min $self->{w} + 4, $tex->{w};	1759	my $w = List::Util::min $self->{w} + 4, $size->[0];
1693	my $h = List::Util::min $self->{h} + 2, $tex->{h};	1760	my $h = List::Util::min $self->{h} + 2, $size->[1];
1694		1761
1695	if ($tex->{format} == GL_ALPHA) {	1762	$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	}	1763	}
1706		1764
1707	#############################################################################	1765	#############################################################################
1708		1766
1709	package CFClient::UI::EntryBase;	1767	package CFClient::UI::EntryBase;
…		…
1742		1800
1743	$text =~ s/./*/g if $self->{hidden};	1801	$text =~ s/./*/g if $self->{hidden};
1744	$self->{layout}->set_text ("$text ");	1802	$self->{layout}->set_text ("$text ");
1745	delete $self->{size_req};	1803	delete $self->{size_req};
1746		1804
1747	$self->_emit (changed => $self->{text});	1805	$self->emit (changed => $self->{text});
1748		1806
1749	$self->realloc;	1807	$self->realloc;
1750	$self->update;	1808	$self->update;
1751	}	1809	}
1752		1810
…		…
1767	my ($w, $h) = $self->SUPER::size_request;	1825	my ($w, $h) = $self->SUPER::size_request;
1768		1826
1769	($w + 1, $h) # add 1 for cursor	1827	($w + 1, $h) # add 1 for cursor
1770	}	1828	}
1771		1829
1772	sub key_down {	1830	sub invoke_key_down {
1773	my ($self, $ev) = @_;	1831	my ($self, $ev) = @_;
1774		1832
1775	my $mod = $ev->{mod};	1833	my $mod = $ev->{mod};
1776	my $sym = $ev->{sym};	1834	my $sym = $ev->{sym};
1777	my $uni = $ev->{unicode};	1835	my $uni = $ev->{unicode};
…		…
1789	} elsif ($sym == CFClient::SDLK_HOME) {	1847	} elsif ($sym == CFClient::SDLK_HOME) {
1790	$self->{cursor} = 0;	1848	$self->{cursor} = 0;
1791	} elsif ($sym == CFClient::SDLK_END) {	1849	} elsif ($sym == CFClient::SDLK_END) {
1792	$self->{cursor} = length $text;	1850	$self->{cursor} = length $text;
1793	} elsif ($uni == 27) {	1851	} elsif ($uni == 27) {
1794	$self->_emit ('escape');	1852	$self->emit ('escape');
1795	} elsif ($uni) {	1853	} elsif ($uni) {
1796	substr $text, $self->{cursor}++, 0, chr $uni;	1854	substr $text, $self->{cursor}++, 0, chr $uni;
1797	} else {	1855	} else {
1798	return 0;	1856	return 0;
1799	}	1857	}
…		…
1803	$self->realloc;	1861	$self->realloc;
1804		1862
1805	1	1863	1
1806	}	1864	}
1807		1865
1808	sub focus_in {	1866	sub invoke_focus_in {
1809	my ($self) = @_;	1867	my ($self) = @_;
1810		1868
1811	$self->{last_activity} = $::NOW;	1869	$self->{last_activity} = $::NOW;
1812		1870
1813	$self->SUPER::focus_in;	1871	$self->SUPER::invoke_focus_in
1814	}	1872	}
1815		1873
1816	sub button_down {	1874	sub invoke_button_down {
1817	my ($self, $ev, $x, $y) = @_;	1875	my ($self, $ev, $x, $y) = @_;
1818		1876
1819	$self->SUPER::button_down ($ev, $x, $y);	1877	$self->SUPER::invoke_button_down ($ev, $x, $y);
1820		1878
1821	my $idx = $self->{layout}->xy_to_index ($x, $y);	1879	my $idx = $self->{layout}->xy_to_index ($x, $y);
1822		1880
1823	# byte-index to char-index	1881	# byte-index to char-index
1824	my $text = $self->{text};	1882	my $text = $self->{text};
1825	utf8::encode $text;	1883	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1826	$self->{cursor} = length substr $text, 0, $idx;	1884	$self->{cursor} = length $text;
1827		1885
1828	$self->_set_text ($self->{text});	1886	$self->_set_text ($self->{text});
1829	$self->update;	1887	$self->update;
1830		1888
1831	1	1889	1
1832	}	1890	}
1833		1891
1834	sub mouse_motion {	1892	sub invoke_mouse_motion {
1835	my ($self, $ev, $x, $y) = @_;	1893	my ($self, $ev, $x, $y) = @_;
1836	# 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#
1837		1895
1838	0	1896	1
1839	}	1897	}
1840		1898
1841	sub _draw {	1899	sub _draw {
1842	my ($self) = @_;	1900	my ($self) = @_;
1843		1901
…		…
1884		1942
1885	our @ISA = CFClient::UI::EntryBase::;	1943	our @ISA = CFClient::UI::EntryBase::;
1886		1944
1887	use CFClient::OpenGL;	1945	use CFClient::OpenGL;
1888		1946
1889	sub key_down {	1947	sub invoke_key_down {
1890	my ($self, $ev) = @_;	1948	my ($self, $ev) = @_;
1891		1949
1892	my $sym = $ev->{sym};	1950	my $sym = $ev->{sym};
1893		1951
1894	if ($sym == 13) {	1952	if ($sym == 13) {
1895	unshift @{$self->{history}},	1953	unshift @{$self->{history}},
1896	my $txt = $self->get_text;	1954	my $txt = $self->get_text;
		1955
1897	$self->{history_pointer} = -1;	1956	$self->{history_pointer} = -1;
1898	$self->{history_saveback} = '';	1957	$self->{history_saveback} = '';
1899	$self->_emit (activate => $txt);	1958	$self->emit (activate => $txt);
1900	$self->update;	1959	$self->update;
1901		1960
1902	} elsif ($sym == CFClient::SDLK_UP) {	1961	} elsif ($sym == CFClient::SDLK_UP) {
1903	if ($self->{history_pointer} < 0) {	1962	if ($self->{history_pointer} < 0) {
1904	$self->{history_saveback} = $self->get_text;	1963	$self->{history_saveback} = $self->get_text;
…		…
1920	} else {	1979	} else {
1921	$self->set_text ($self->{history_saveback});	1980	$self->set_text ($self->{history_saveback});
1922	}	1981	}
1923		1982
1924	} else {	1983	} else {
1925	return $self->SUPER::key_down ($ev)	1984	return $self->SUPER::invoke_key_down ($ev)
1926	}	1985	}
1927		1986
1928	1	1987	1
1929	}	1988	}
1930		1989
…		…
1954	can_events => 1,	2013	can_events => 1,
1955	@_	2014	@_
1956	)	2015	)
1957	}	2016	}
1958		2017
1959	sub activate { }
1960
1961	sub button_up {	2018	sub invoke_button_up {
1962	my ($self, $ev, $x, $y) = @_;	2019	my ($self, $ev, $x, $y) = @_;
1963		2020
1964	$self->emit ("activate")	2021	$self->emit ("activate")
1965	if $x >= 0 && $x < $self->{w}	2022	if $x >= 0 && $x < $self->{w}
1966	&& $y >= 0 && $y < $self->{h};	2023	&& $y >= 0 && $y < $self->{h};
…		…
2008	can_events => 1,	2065	can_events => 1,
2009	@_	2066	@_
2010	);	2067	);
2011	}	2068	}
2012		2069
2013	sub activate { }
2014
2015	sub button_up {	2070	sub invoke_button_up {
2016	my ($self, $ev, $x, $y) = @_;	2071	my ($self, $ev, $x, $y) = @_;
2017		2072
2018	$self->emit ("activate")	2073	$self->emit ("activate")
2019	if $x >= 0 && $x < $self->{w}	2074	if $x >= 0 && $x < $self->{w}
2020	&& $y >= 0 && $y < $self->{h};	2075	&& $y >= 0 && $y < $self->{h};
…		…
2054	my ($self) = @_;	2109	my ($self) = @_;
2055		2110
2056	(6) x 2	2111	(6) x 2
2057	}	2112	}
2058		2113
		2114	sub toggle {
		2115	my ($self) = @_;
		2116
		2117	$self->{state} = !$self->{state};
		2118	$self->emit (changed => $self->{state});
		2119	$self->update;
		2120	}
		2121
2059	sub button_down {	2122	sub invoke_button_down {
2060	my ($self, $ev, $x, $y) = @_;	2123	my ($self, $ev, $x, $y) = @_;
2061		2124
2062	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2125	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2063	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2126	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2064	$self->{state} = !$self->{state};	2127	$self->toggle;
2065	$self->_emit (changed => $self->{state});
2066	} else {	2128	} else {
2067	return 0	2129	return 0
2068	}	2130	}
2069		2131
2070	1	2132	1
…		…
2095	package CFClient::UI::Image;	2157	package CFClient::UI::Image;
2096		2158
2097	our @ISA = CFClient::UI::Base::;	2159	our @ISA = CFClient::UI::Base::;
2098		2160
2099	use CFClient::OpenGL;	2161	use CFClient::OpenGL;
2100	use Carp qw/confess/;
2101		2162
2102	our %loaded_images;	2163	our %texture_cache;
2103		2164
2104	sub new {	2165	sub new {
2105	my $class = shift;	2166	my $class = shift;
2106		2167
2107	my $self = $class->SUPER::new (can_events => 0, @_);	2168	my $self = $class->SUPER::new (
		2169	can_events => 0,
		2170	@_,
		2171	);
2108		2172
2109	$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";
2110		2175
2111	$loaded_images{$self->{image}} ||=	2176	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2112	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;
2113		2178
2114	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2179	Scalar::Util::weaken $texture_cache{$self->{path}};
2115		2180
2116	Scalar::Util::weaken $loaded_images{$self->{image}};	2181	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2117
2118	$self->{aspect} = $tex->{w} / $tex->{h};
2119		2182
2120	$self	2183	$self
2121	}	2184	}
2122		2185
2123	sub size_request {	2186	sub size_request {
2124	my ($self) = @_;	2187	my ($self) = @_;
2125		2188
2126	($self->{tex}->{w}, $self->{tex}->{h})	2189	($self->{tex}{w}, $self->{tex}{h})
2127	}	2190	}
2128		2191
2129	sub _draw {	2192	sub _draw {
2130	my ($self) = @_;	2193	my ($self) = @_;
2131		2194
…		…
2240	my $ycut1 = max 0, min 1, $ycut;	2303	my $ycut1 = max 0, min 1, $ycut;
2241	my $ycut2 = max 0, min 1, $ycut - 1;	2304	my $ycut2 = max 0, min 1, $ycut - 1;
2242		2305
2243	my $h1 = $self->{h} * (1 - $ycut1);	2306	my $h1 = $self->{h} * (1 - $ycut1);
2244	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);
2245		2311
2246	glEnable GL_BLEND;	2312	glEnable GL_BLEND;
2247	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2313	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2248	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2314	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2249	glEnable GL_TEXTURE_2D;	2315	glEnable GL_TEXTURE_2D;
…		…
2268		2334
2269	if ($t3) {	2335	if ($t3) {
2270	glBindTexture GL_TEXTURE_2D, $t3->{name};	2336	glBindTexture GL_TEXTURE_2D, $t3->{name};
2271	glBegin GL_QUADS;	2337	glBegin GL_QUADS;
2272	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2338	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2273	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2339	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2274	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2340	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2275	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2341	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2276	glEnd;	2342	glEnd;
2277	}	2343	}
2278		2344
2279	glDisable GL_BLEND;	2345	glDisable GL_BLEND;
…		…
2367	$self->update;	2433	$self->update;
2368		2434
2369	$self	2435	$self
2370	}	2436	}
2371		2437
2372	sub changed { }
2373
2374	sub set_range {	2438	sub set_range {
2375	my ($self, $range) = @_;	2439	my ($self, $range) = @_;
2376		2440
2377	($range, $self->{range}) = ($self->{range}, $range);	2441	($range, $self->{range}) = ($self->{range}, $range);
2378		2442
…		…
2398	if $unit;	2462	if $unit;
2399		2463
2400	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2464	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2401		2465
2402	if ($value != $old_value) {	2466	if ($value != $old_value) {
2403	$self->_emit (changed => $value);	2467	$self->emit (changed => $value);
2404	$self->update;	2468	$self->update;
2405	}	2469	}
2406	}	2470	}
2407		2471
2408	sub size_request {	2472	sub size_request {
2409	my ($self) = @_;	2473	my ($self) = @_;
2410		2474
2411	($self->{req_w}, $self->{req_h})	2475	($self->{req_w}, $self->{req_h})
2412	}	2476	}
2413		2477
2414	sub button_down {	2478	sub invoke_button_down {
2415	my ($self, $ev, $x, $y) = @_;	2479	my ($self, $ev, $x, $y) = @_;
2416		2480
2417	$self->SUPER::button_down ($ev, $x, $y);	2481	$self->SUPER::invoke_button_down ($ev, $x, $y);
2418		2482
2419	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2483	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2420		2484
2421	$self->mouse_motion ($ev, $x, $y)	2485	$self->invoke_mouse_motion ($ev, $x, $y)
2422	}	2486	}
2423		2487
2424	sub mouse_motion {	2488	sub invoke_mouse_motion {
2425	my ($self, $ev, $x, $y) = @_;	2489	my ($self, $ev, $x, $y) = @_;
2426		2490
2427	if ($GRAB == $self) {	2491	if ($GRAB == $self) {
2428	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2492	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2429		2493
…		…
2435	} else {	2499	} else {
2436	return 0;	2500	return 0;
2437	}	2501	}
2438		2502
2439	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
2440	}	2514	}
2441		2515
2442	sub update {	2516	sub update {
2443	my ($self) = @_;	2517	my ($self) = @_;
2444		2518
…		…
2545	sub new {	2619	sub new {
2546	my $class = shift;	2620	my $class = shift;
2547		2621
2548	my $self = $class->SUPER::new (	2622	my $self = $class->SUPER::new (
2549	fontsize => 1,	2623	fontsize => 1,
2550	can_events => 0,	2624	can_events => 1,
2551	indent => 0,	2625	indent => 0,
2552	#font => default_font	2626	#font => default_font
2553	@_,	2627	@_,
2554		2628
2555	layout => (new CFClient::Layout 1),	2629	layout => (new CFClient::Layout),
2556	par => [],	2630	par => [],
2557	height => 0,	2631	height => 0,
2558	children => [	2632	children => [
2559	(new CFClient::UI::Empty expand => 1),	2633	(new CFClient::UI::Empty expand => 1),
2560	(new CFClient::UI::Slider vertical => 1),	2634	(new CFClient::UI::Slider vertical => 1),
…		…
2571		2645
2572	$self->{fontsize} = $fontsize;	2646	$self->{fontsize} = $fontsize;
2573	$self->reflow;	2647	$self->reflow;
2574	}	2648	}
2575		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
2576	sub size_allocate {	2659	sub invoke_size_allocate {
2577	my ($self, $w, $h) = @_;	2660	my ($self, $w, $h) = @_;
2578		2661
2579	$self->SUPER::size_allocate ($w, $h);	2662	my ($empty, $slider, @other) = @{ $self->{children} };
		2663	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2580		2664
2581	$self->{layout}->set_font ($self->{font}) if $self->{font};	2665	$self->{layout}->set_font ($self->{font}) if $self->{font};
2582	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2666	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2583	$self->{layout}->set_width ($self->{children}[0]{w});	2667	$self->{layout}->set_width ($empty->{w});
2584	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2668	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2585		2669
2586	$self->reflow;	2670	$self->reflow;
2587	}
2588		2671
2589	sub text_size {	2672	local $self->{children} = [$empty, $slider];
		2673	$self->SUPER::invoke_size_allocate ($w, $h)
		2674	}
		2675
		2676	sub invoke_mouse_wheel {
2590	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) = @_;
2591		2688
2592	my $layout = $self->{layout};	2689	my $layout = $self->{layout};
2593		2690
		2691	$layout->set_font ($self->{font}) if $self->{font};
		2692	$layout->set_foreground (@{$para->{fg}});
2594	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2693	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2595	$layout->set_width ($self->{children}[0]{w} - $indent);	2694	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2596	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2695	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2597	$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}}
2598		2702	);
		2703
2599	$layout->size	2704	$layout
2600	}	2705	}
2601		2706
2602	sub reflow {	2707	sub reflow {
2603	my ($self) = @_;	2708	my ($self) = @_;
2604		2709
…		…
2613	$self->{children}[1]->set_value ($offset);	2718	$self->{children}[1]->set_value ($offset);
2614	}	2719	}
2615		2720
2616	sub clear {	2721	sub clear {
2617	my ($self) = @_;	2722	my ($self) = @_;
		2723
		2724	my (undef, undef, @other) = @{ $self->{children} };
		2725	$self->remove ($_) for @other;
2618		2726
2619	$self->{par} = [];	2727	$self->{par} = [];
2620	$self->{height} = 0;	2728	$self->{height} = 0;
2621	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2729	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2622	}	2730	}
2623		2731
2624	sub add_paragraph {	2732	sub add_paragraph {
2625	my ($self, $color, $text, $indent) = @_;	2733	my ($self, $color, $para, $indent) = @_;
2626		2734
2627	for my $line (split /\n/, $text) {	2735	my ($text, @w) = ref $para ? @$para : $para;
2628	my ($w, $h) = $self->text_size ($line);	2736
2629	$self->{height} += $h;	2737	$para = {
2630	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,
2631	}	2744	};
2632		2745
2633	$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;
2634	}	2758	}
2635		2759
2636	sub update {	2760	sub update {
2637	my ($self) = @_;	2761	my ($self) = @_;
2638		2762
…		…
2646	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2770	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2647		2771
2648	if (delete $self->{need_reflow}) {	2772	if (delete $self->{need_reflow}) {
2649	my $height = 0;	2773	my $height = 0;
2650		2774
2651	my $layout = $self->{layout};
2652
2653	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2654
2655	for (@{$self->{par}}) {	2775	for my $para (@{$self->{par}}) {
2656	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2776	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2657	$layout->set_width ($W - $_->[3]);	2777	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;	2778	my ($w, $h) = $layout->size;
2661	$_->[0] = $w + $_->[3];	2779
2662	$_->[1] = $h;	2780	$para->{w} = $w + $para->{indent};
		2781	$para->{h} = $h;
		2782	$para->{wrapped} = $layout->has_wrapped;
2663	}	2783	}
2664		2784
2665	$height += $_->[1];	2785	$height += $para->{h};
2666	}	2786	}
2667		2787
2668	$self->{height} = $height;	2788	$self->{height} = $height;
2669		2789
2670	$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]);
2671		2791
2672	delete $self->{texture};	2792	delete $self->{texture};
		2793	}
		2794
		2795	if (delete $self->{scroll_to_bottom}) {
		2796	$self->{children}[1]->set_value (1e10);
2673	}	2797	}
2674		2798
2675	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2799	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2676	glClearColor 0, 0, 0, 0;	2800	glClearColor 0, 0, 0, 0;
2677	glClear GL_COLOR_BUFFER_BIT;	2801	glClear GL_COLOR_BUFFER_BIT;
…		…
2681	my $y0 = $top;	2805	my $y0 = $top;
2682	my $y1 = $top + $H;	2806	my $y1 = $top + $H;
2683		2807
2684	my $y = 0;	2808	my $y = 0;
2685		2809
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}}) {	2810	for my $para (@{$self->{par}}) {
2695	my $h = $par->[1];	2811	my $h = $para->{h};
2696		2812
2697	if ($y0 < $y + $h && $y < $y1) {	2813	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		2814
2703	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2815	my $layout = $self->get_layout ($para);
2704		2816
2705	glRasterPos $par->[3], $y - $y0;	2817	$layout->render ($para->{indent}, $y - $y0);
2706	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	}
2707	}	2831	}
2708		2832
2709	$y += $h;	2833	$y += $h;
2710	}	2834	}
2711
2712	glDisable GL_BLEND;
2713	};	2835	};
2714	});	2836	});
		2837	}
		2838
		2839	sub reconfigure {
		2840	my ($self) = @_;
		2841
		2842	$self->SUPER::reconfigure;
		2843
		2844	$_->{w} = 1e10 for @{ $self->{par} };
		2845	$self->reflow;
2715	}	2846	}
2716		2847
2717	sub _draw {	2848	sub _draw {
2718	my ($self) = @_;	2849	my ($self) = @_;
2719		2850
…		…
2722	glColor 0, 0, 0, 1;	2853	glColor 0, 0, 0, 1;
2723	$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});
2724	glDisable GL_TEXTURE_2D;	2855	glDisable GL_TEXTURE_2D;
2725		2856
2726	$self->{children}[1]->draw;	2857	$self->{children}[1]->draw;
2727
2728	}	2858	}
2729		2859
2730	#############################################################################	2860	#############################################################################
2731		2861
2732	package CFClient::UI::Animator;	2862	package CFClient::UI::Animator;
…		…
2841	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2971	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2842		2972
2843	($w + 4, $h + 4)	2973	($w + 4, $h + 4)
2844	}	2974	}
2845		2975
2846	sub size_allocate {	2976	sub invoke_size_allocate {
2847	my ($self, $w, $h) = @_;	2977	my ($self, $w, $h) = @_;
2848		2978
2849	$self->SUPER::size_allocate ($w - 4, $h - 4);	2979	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2850	}	2980	}
2851		2981
2852	sub visibility_change {	2982	sub invoke_visibility_change {
2853	my ($self, $visible) = @_;	2983	my ($self, $visible) = @_;
2854		2984
2855	return unless $visible;	2985	return unless $visible;
2856		2986
2857	$self->{root}->on_post_alloc ("move_$self" => sub {	2987	$self->{root}->on_post_alloc ("move_$self" => sub {
…		…
3005	for my $item (@{ $self->{items} }) {	3135	for my $item (@{ $self->{items} }) {
3006	my ($widget, $cb, $tooltip) = @$item;	3136	my ($widget, $cb, $tooltip) = @$item;
3007		3137
3008	# handle various types of items, only text for now	3138	# handle various types of items, only text for now
3009	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 {
3010	$widget = new CFClient::UI::Label	3154	$widget = new CFClient::UI::Label
3011	can_hover => 1,	3155	can_hover => 1,
3012	can_events => 1,	3156	can_events => 1,
3013	markup => $widget,	3157	markup => $widget,
3014	tooltip => $tooltip	3158	tooltip => $tooltip;
		3159	}
3015	}	3160	}
3016		3161
3017	$self->{item}{$widget} = $item;	3162	$self->{item}{$widget} = $item;
3018		3163
3019	$self->{vbox}->add ($widget);	3164	$self->{vbox}->add ($widget);
…		…
3024		3169
3025	# 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)
3026	sub popup {	3171	sub popup {
3027	my ($self, $ev) = @_;	3172	my ($self, $ev) = @_;
3028		3173
3029	$self->_emit ("popdown");	3174	$self->emit ("popdown");
3030		3175
3031	# maybe save $GRAB? must be careful about events...	3176	# maybe save $GRAB? must be careful about events...
3032	$GRAB = $self;	3177	$GRAB = $self;
3033	$self->{button} = $ev->{button};	3178	$self->{button} = $ev->{button};
3034		3179
3035	$self->show;	3180	$self->show;
3036	$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);
3037	}	3182	}
3038		3183
3039	sub mouse_motion {	3184	sub invoke_mouse_motion {
3040	my ($self, $ev, $x, $y) = @_;	3185	my ($self, $ev, $x, $y) = @_;
3041		3186
3042	# TODO: should use vbox->find_widget or so	3187	# TODO: should use vbox->find_widget or so
3043	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3188	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
3044	$self->{hover} = $self->{item}{$HOVER};	3189	$self->{hover} = $self->{item}{$HOVER};
3045		3190
3046	0	3191	0
3047	}	3192	}
3048		3193
3049	sub button_up {	3194	sub invoke_button_up {
3050	my ($self, $ev, $x, $y) = @_;	3195	my ($self, $ev, $x, $y) = @_;
3051		3196
3052	if ($ev->{button} == $self->{button}) {	3197	if ($ev->{button} == $self->{button}) {
3053	undef $GRAB;	3198	undef $GRAB;
3054	$self->hide;	3199	$self->hide;
3055		3200
3056	$self->_emit ("popdown");	3201	$self->emit ("popdown");
3057	$self->{hover}[1]->() if $self->{hover};	3202	$self->{hover}[1]->() if $self->{hover};
3058	} else {	3203	} else {
3059	return 0	3204	return 0
3060	}	3205	}
3061		3206
…		…
3088		3233
3089	$self->{current} = $self->{children}[0]	3234	$self->{current} = $self->{children}[0]
3090	if @{ $self->{children} };	3235	if @{ $self->{children} };
3091	}	3236	}
3092		3237
		3238	sub get_current_page {
		3239	my ($self) = @_;
		3240
		3241	$self->{current}
		3242	}
		3243
3093	sub set_current_page {	3244	sub set_current_page {
3094	my ($self, $page_or_widget) = @_;	3245	my ($self, $page_or_widget) = @_;
3095		3246
3096	my $widget = ref $page_or_widget	3247	my $widget = ref $page_or_widget
3097	? $page_or_widget	3248	? $page_or_widget
3098	: $self->{children}[$page_or_widget];	3249	: $self->{children}[$page_or_widget];
3099		3250
3100	$self->{current} = $widget;	3251	$self->{current} = $widget;
3101	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3252	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3102		3253
3103	$self->_emit (page_changed => $self->{current});	3254	$self->emit (page_changed => $self->{current});
3104		3255
3105	$self->realloc;	3256	$self->realloc;
3106	}	3257	}
3107		3258
3108	sub visible_children {	3259	sub visible_children {
…		…
3113	my ($self) = @_;	3264	my ($self) = @_;
3114		3265
3115	$self->{current}->size_request	3266	$self->{current}->size_request
3116	}	3267	}
3117		3268
3118	sub size_allocate {	3269	sub invoke_size_allocate {
3119	my ($self, $w, $h) = @_;	3270	my ($self, $w, $h) = @_;
3120		3271
3121	$self->{current}->configure (0, 0, $w, $h);	3272	$self->{current}->configure (0, 0, $w, $h);
		3273
		3274	1
3122	}	3275	}
3123		3276
3124	sub _draw {	3277	sub _draw {
3125	my ($self) = @_;	3278	my ($self) = @_;
3126		3279
…		…
3161	);	3314	);
3162		3315
3163	$self->{multiplexer}->add ($widget);	3316	$self->{multiplexer}->add ($widget);
3164	}	3317	}
3165		3318
		3319	sub get_current_page {
		3320	my ($self) = @_;
		3321
		3322	$self->{multiplexer}->get_current_page
		3323	}
		3324
3166	sub set_current_page {	3325	sub set_current_page {
3167	my ($self, $page) = @_;	3326	my ($self, $page) = @_;
3168		3327
3169	$self->{multiplexer}->set_current_page ($page);	3328	$self->{multiplexer}->set_current_page ($page);
3170	$self->_emit (page_changed => $self->{multiplexer}{current});	3329	$self->emit (page_changed => $self->{multiplexer}{current});
3171	}	3330	}
3172		3331
3173	#############################################################################	3332	#############################################################################
3174		3333
3175	package CFClient::UI::Combobox;	3334	package CFClient::UI::Combobox;
…		…
3190	$self->_set_value ($self->{value});	3349	$self->_set_value ($self->{value});
3191		3350
3192	$self	3351	$self
3193	}	3352	}
3194		3353
3195	sub button_down {	3354	sub invoke_button_down {
3196	my ($self, $ev) = @_;	3355	my ($self, $ev) = @_;
3197		3356
3198	my @menu_items;	3357	my @menu_items;
3199		3358
3200	for (@{ $self->{options} }) {	3359	for (@{ $self->{options} }) {
…		…
3221	my ($self, $value) = @_;	3380	my ($self, $value) = @_;
3222		3381
3223	return unless $self->{value} ne $value;	3382	return unless $self->{value} ne $value;
3224		3383
3225	$self->_set_value ($value);	3384	$self->_set_value ($value);
3226	$self->_emit (changed => $value);	3385	$self->emit (changed => $value);
3227	}	3386	}
3228		3387
3229	#############################################################################	3388	#############################################################################
3230		3389
3231	package CFClient::UI::Statusbox;	3390	package CFClient::UI::Statusbox;
…		…
3346	count => 1,	3505	count => 1,
3347	%arg,	3506	%arg,
3348	};	3507	};
3349	}	3508	}
3350		3509
		3510	$ROOT->on_refresh (reorder => sub {
3351	$self->reorder;	3511	$self->reorder;
		3512	});
3352	}	3513	}
3353		3514
3354	sub reconfigure {	3515	sub reconfigure {
3355	my ($self) = @_;	3516	my ($self) = @_;
3356		3517
…		…
3371		3532
3372	#############################################################################	3533	#############################################################################
3373		3534
3374	package CFClient::UI::Inventory;	3535	package CFClient::UI::Inventory;
3375		3536
3376	our @ISA = CFClient::UI::ScrolledWindow::;	3537	our @ISA = CFClient::UI::Table::;
3377		3538
3378	sub new {	3539	sub new {
3379	my $class = shift;	3540	my $class = shift;
3380		3541
3381	my $self = $class->SUPER::new (	3542	my $self = $class->SUPER::new (
3382	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),	3543	col_expand => [0, 1, 0],
3383	@_,	3544	@_,
3384	);	3545	);
3385		3546
3386	$self	3547	$self
3387	}	3548	}
3388		3549
3389	sub set_items {	3550	sub set_items {
3390	my ($self, $items) = @_;	3551	my ($self, $items) = @_;
3391		3552
3392	$self->{child}->clear;	3553	$self->clear;
3393	return unless $items;	3554	return unless $items;
3394		3555
3395	my @items = sort {	3556	my @items = sort {
3396	($a->{type} <=> $b->{type})	3557	($a->{type} <=> $b->{type})
3397	or ($a->{name} cmp $b->{name})	3558	or ($a->{name} cmp $b->{name})
3398	} @$items;	3559	} values %$items;
3399		3560
3400	$self->{real_items} = \@items;	3561	$self->{real_items} = \@items;
3401		3562
3402	my $row = 0;	3563	my $row = 0;
3403	for my $item (@items) {	3564	for my $item (@items) {
3404	CFClient::Item::update_widgets $item;	3565	CFClient::Item::update_widgets $item;
3405		3566
3406	$self->{child}->add (0, $row, $item->{face_widget});	3567	$self->add (0, $row, $item->{face_widget});
3407	$self->{child}->add (1, $row, $item->{desc_widget});	3568	$self->add (1, $row, $item->{desc_widget});
3408	$self->{child}->add (2, $row, $item->{weight_widget});	3569	$self->add (2, $row, $item->{weight_widget});
3409		3570
3410	$row++;	3571	$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) = @_;
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	});
3531	}
3532
3533	# $mod and $sym are the modifiers and key symbol
3534	# $cmds is a array ref of strings (the commands)
3535	# $cb is the callback that is executed on OK
3536	# $ccb is the callback that is executed on CANCEL and
3537	# when the binding was unsuccessful on OK
3538	sub set_binding {
3539	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3540
3541	$self->clear_command_list;
3542	$self->{recording} = 0;
3543	$self->{rec_btn}->set_text ("start recording");
3544
3545	$self->{binding} = [$mod, $sym];
3546	$self->{commands} = $cmds;
3547
3548	$self->{binding_change} = $cb;
3549	$self->{binding_cancel} = $ccb;
3550
3551	$self->update_binding_widgets;
3552	}
3553
3554	# this is a shortcut method that asks for a binding
3555	# and then just binds it.
3556	sub do_quick_binding {
3557	my ($self, $cmds) = @_;
3558	$self->set_binding (undef, undef, $cmds, sub {
3559	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3560	});
3561	$self->ask_for_bind (1);
3562	}
3563
3564	sub update_binding_widgets {
3565	my ($self) = @_;
3566	my ($mod, $sym, $cmds) = $self->get_binding;
3567	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3568	$self->set_command_list ($cmds);
3569	}
3570
3571	sub get_binding {
3572	my ($self) = @_;
3573	return (
3574	$self->{binding}->[0],
3575	$self->{binding}->[1],
3576	[ grep { defined $_ } @{$self->{commands}} ]
3577	);
3578	}
3579
3580	sub clear_command_list {
3581	my ($self) = @_;
3582	$self->{cmdbox}->clear ();
3583	}
3584
3585	sub set_command_list {
3586	my ($self, $cmds) = @_;
3587
3588	$self->{cmdbox}->clear ();
3589	$self->{commands} = $cmds;
3590
3591	my $idx = 0;
3592
3593	for (@$cmds) {
3594	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3595
3596	my $i = $idx;
3597	$hb->add (new CFClient::UI::Label text => $_);
3598	$hb->add (new CFClient::UI::Button
3599	text => "delete",
3600	tooltip => "Deletes the action from the record",
3601	on_activate => sub {
3602	$self->{cmdbox}->remove ($hb);
3603	$cmds->[$i] = undef;
3604	});
3605
3606
3607	$idx++
3608	}	3572	}
3609	}	3573	}
3610		3574
3611	#############################################################################	3575	#############################################################################
3612		3576
…		…
3666	} elsif ($ev->{button} == 2) {	3630	} elsif ($ev->{button} == 2) {
3667	$::CONN->user_send ("invoke $spell->{name}");	3631	$::CONN->user_send ("invoke $spell->{name}");
3668	} elsif ($ev->{button} == 3) {	3632	} elsif ($ev->{button} == 3) {
3669	(new CFClient::UI::Menu	3633	(new CFClient::UI::Menu
3670	items => [	3634	items => [
3671	["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}"]) }],
3672	["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}"]) }],
3673	],	3637	],
3674	)->popup ($ev);	3638	)->popup ($ev);
3675	} else {	3639	} else {
3676	return 0;	3640	return 0;
…		…
3771	$coord = $max - $size if $coord > $max - $size;	3735	$coord = $max - $size if $coord > $max - $size;
3772		3736
3773	int $coord + 0.5	3737	int $coord + 0.5
3774	}	3738	}
3775		3739
3776	sub size_allocate {	3740	sub invoke_size_allocate {
3777	my ($self, $w, $h) = @_;	3741	my ($self, $w, $h) = @_;
3778		3742
3779	for my $child ($self->children) {	3743	for my $child ($self->children) {
3780	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)};
3781		3745
…		…
3785	$X = _to_pixel $X, $W, $self->{w};	3749	$X = _to_pixel $X, $W, $self->{w};
3786	$Y = _to_pixel $Y, $H, $self->{h};	3750	$Y = _to_pixel $Y, $H, $self->{h};
3787		3751
3788	$child->configure ($X, $Y, $W, $H);	3752	$child->configure ($X, $Y, $W, $H);
3789	}	3753	}
		3754
		3755	1
3790	}	3756	}
3791		3757
3792	sub coord2local {	3758	sub coord2local {
3793	my ($self, $x, $y) = @_;	3759	my ($self, $x, $y) = @_;
3794		3760
…		…
3920	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3886	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3921		3887
3922	$w = 0 if $w < 0;	3888	$w = 0 if $w < 0;
3923	$h = 0 if $h < 0;	3889	$h = 0 if $h < 0;
3924		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
3925	$w = int $w + 0.5;	3897	$w = int $w + 0.5;
3926	$h = int $h + 0.5;	3898	$h = int $h + 0.5;
3927		3899
3928	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}) {
3929	$widget->{old_w} = $widget->{w};	3901	$widget->{old_w} = $widget->{w};

Diff Legend

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