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.260 by elmex, Tue May 30 14:35:09 2006 UTC vs.
Revision 1.285 by root, Mon Jun 5 03:07:01 2006 UTC

…		…
3	use utf8;	3	use utf8;
4	use strict;	4	use strict;
5		5
6	use Scalar::Util ();	6	use Scalar::Util ();
7	use List::Util ();	7	use List::Util ();
		8	use Event;
8		9
9	use CFClient;	10	use CFClient;
10	use CFClient::Texture;	11	use CFClient::Texture;
11		12
12	our ($FOCUS, $HOVER, $GRAB); # various widgets	13	our ($FOCUS, $HOVER, $GRAB); # various widgets
…		…
15	our $ROOT;	16	our $ROOT;
16	our $TOOLTIP;	17	our $TOOLTIP;
17	our $BUTTON_STATE;	18	our $BUTTON_STATE;
18		19
19	our %WIDGET; # all widgets, weak-referenced	20	our %WIDGET; # all widgets, weak-referenced
		21
		22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
		23	if (!$GRAB) {
		24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
		25	if (length $widget->{tooltip}) {
		26	if ($TOOLTIP->{owner} != $widget) {
		27	$TOOLTIP->hide;
		28
		29	$TOOLTIP->{owner} = $widget;
		30
		31	return if $ENV{CFPLUS_DEBUG} & 8;
		32
		33	my $tip = $widget->{tooltip};
		34
		35	$tip = $tip->($widget) if CODE:: eq ref $tip;
		36
		37	$TOOLTIP->set_tooltip_from ($widget);
		38	$TOOLTIP->show;
		39	}
		40
		41	return;
		42	}
		43	}
		44	}
		45
		46	$TOOLTIP->hide;
		47	delete $TOOLTIP->{owner};
		48	});
20		49
21	sub get_layout {	50	sub get_layout {
22	my $layout;	51	my $layout;
23		52
24	for (grep { $_->{name} } values %WIDGET) {	53	for (grep { $_->{name} } values %WIDGET) {
…		…
39	my ($layout) = @_;	68	my ($layout) = @_;
40		69
41	$LAYOUT = $layout;	70	$LAYOUT = $layout;
42	}	71	}
43		72
44	sub check_tooltip {
45	if (!$GRAB) {
46	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
47	if (length $widget->{tooltip}) {
48
49	if ($TOOLTIP->{owner} != $widget) {
50	$TOOLTIP->hide;
51
52	$TOOLTIP->{owner} = $widget;
53
54	my $tip = $widget->{tooltip};
55
56	$tip = $tip->($widget) if CODE:: eq ref $tip;
57
58	$TOOLTIP->set_tooltip_from ($widget);
59	$TOOLTIP->show;
60	}
61
62	return;
63	}
64	}
65	}
66
67	$TOOLTIP->hide;
68	delete $TOOLTIP->{owner};
69	}
70
71	# class methods for events	73	# class methods for events
72	sub feed_sdl_key_down_event {	74	sub feed_sdl_key_down_event {
73	$FOCUS->emit (key_down => $_[0])	75	$FOCUS->emit (key_down => $_[0])
74	if $FOCUS;	76	if $FOCUS;
75	}	77	}
…		…
87	my $widget = $ROOT->find_widget ($x, $y);	89	my $widget = $ROOT->find_widget ($x, $y);
88		90
89	$GRAB = $widget;	91	$GRAB = $widget;
90	$GRAB->update if $GRAB;	92	$GRAB->update if $GRAB;
91		93
92	check_tooltip;	94	$TOOLTIP_WATCHER->cb->();
93	}	95	}
94		96
95	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
96		98
97	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
…		…
112	if (!$BUTTON_STATE) {	114	if (!$BUTTON_STATE) {
113	my $grab = $GRAB; undef $GRAB;	115	my $grab = $GRAB; undef $GRAB;
114	$grab->update if $grab;	116	$grab->update if $grab;
115	$GRAB->update if $GRAB;	117	$GRAB->update if $GRAB;
116		118
117	check_tooltip;	119	$TOOLTIP_WATCHER->cb->();
118	}	120	}
119	}	121	}
120		122
121	sub feed_sdl_motion_event {	123	sub feed_sdl_motion_event {
122	my ($ev) = @_;	124	my ($ev) = @_;
…		…
128	my $hover = $HOVER; $HOVER = $widget;	130	my $hover = $HOVER; $HOVER = $widget;
129		131
130	$hover->update if $hover && $hover->{can_hover};	132	$hover->update if $hover && $hover->{can_hover};
131	$HOVER->update if $HOVER && $HOVER->{can_hover};	133	$HOVER->update if $HOVER && $HOVER->{can_hover};
132		134
133	check_tooltip;	135	$TOOLTIP_WATCHER->start;
134	}	136	}
135		137
136	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))	138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
137	if $HOVER;	139	if $HOVER;
138	}	140	}
…		…
170	sub rescale_widgets {	172	sub rescale_widgets {
171	my ($sx, $sy) = @_;	173	my ($sx, $sy) = @_;
172		174
173	for my $widget (values %WIDGET) {	175	for my $widget (values %WIDGET) {
174	if ($widget->{is_toplevel}) {	176	if ($widget->{is_toplevel}) {
175	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;	177	$widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
176	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;	178	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
177		179
178	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;	180	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
179	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};	181	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
180	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};	182	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
181	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;	183	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
182	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};	184	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
183	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};	185	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
184		186
185	$widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;	187	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
186	$widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;	188	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
187		189
188	}	190	}
189	}	191	}
190		192
191	reconfigure_widgets;	193	reconfigure_widgets;
…		…
276	delete $self->{visible};	278	delete $self->{visible};
277		279
278	undef $GRAB if $GRAB == $self;	280	undef $GRAB if $GRAB == $self;
279	undef $HOVER if $HOVER == $self;	281	undef $HOVER if $HOVER == $self;
280		282
281	CFClient::UI::check_tooltip	283	$CFClient::UI::TOOLTIP_WATCHER->cb->()
282	if $TOOLTIP->{owner} == $self;	284	if $TOOLTIP->{owner} == $self;
283		285
284	$self->focus_out;	286	$self->focus_out;
285		287
286	$self->emit (visibility_change => 0);	288	$self->emit (visibility_change => 0);
…		…
370	sub size_allocate {	372	sub size_allocate {
371	# nothing to be done	373	# nothing to be done
372	}	374	}
373		375
374	sub children {	376	sub children {
		377	# nop
		378	}
		379
		380	sub visible_children {
		381	$_[0]->children
375	}	382	}
376		383
377	sub set_max_size {	384	sub set_max_size {
378	my ($self, $w, $h) = @_;	385	my ($self, $w, $h) = @_;
379		386
380	delete $self->{max_w}; $self->{max_w} = $w if $w;	387	$self->{max_w} = int $w if defined $w;
381	delete $self->{max_h}; $self->{max_h} = $h if $h;	388	$self->{max_h} = int $h if defined $h;
		389
		390	$self->realloc;
382	}	391	}
383		392
384	sub set_tooltip {	393	sub set_tooltip {
385	my ($self, $tooltip) = @_;	394	my ($self, $tooltip) = @_;
386		395
…		…
391		400
392	$self->{tooltip} = $tooltip;	401	$self->{tooltip} = $tooltip;
393		402
394	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	403	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
395	delete $CFClient::UI::TOOLTIP->{owner};	404	delete $CFClient::UI::TOOLTIP->{owner};
396	CFClient::UI::check_tooltip;	405	$CFClient::UI::TOOLTIP_WATCHER->cb->();
397	}	406	}
398	}	407	}
399		408
400	# translate global coordinates to local coordinate system	409	# translate global coordinates to local coordinate system
401	sub coord2local {	410	sub coord2local {
…		…
438		447
439	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
440	unless $FOCUS;	449	unless $FOCUS;
441	}	450	}
442		451
443	sub mouse_motion { }	452	sub mouse_motion { 0 }
444	sub button_up { }	453	sub button_up { 0 }
445	sub key_down { }	454	sub key_down { 0 }
446	sub key_up { }	455	sub key_up { 0 }
447		456
448	sub button_down {	457	sub button_down {
449	my ($self, $ev, $x, $y) = @_;	458	my ($self, $ev, $x, $y) = @_;
450		459
451	$self->focus_in;	460	$self->focus_in;
452	}
453		461
454	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	462	0
455	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	463	}
456	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
457	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
458	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
459		464
460	sub find_widget {	465	sub find_widget {
461	my ($self, $x, $y) = @_;	466	my ($self, $x, $y) = @_;
462		467
463	return () unless $self->{can_events};	468	return () unless $self->{can_events};
…		…
525		530
526	$self->realloc;	531	$self->realloc;
527	$self->update;	532	$self->update;
528	}	533	}
529		534
		535	# using global variables seems a bit hacky, but passing through all drawing
		536	# functions seems pointless.
		537	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
		538
530	sub draw {	539	sub draw {
531	my ($self) = @_;	540	my ($self) = @_;
532		541
533	return unless $self->{h} && $self->{w};	542	return unless $self->{h} && $self->{w};
		543
		544	# update screen rectangle
		545	local $draw_x = $draw_x + $self->{x};
		546	local $draw_y = $draw_y + $self->{y};
		547	local $draw_w = $draw_x + $self->{w};
		548	local $draw_h = $draw_y + $self->{h};
		549
		550	# skip widgets that are entirely outside the drawing area
		551	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		552	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
534		553
535	glPushMatrix;	554	glPushMatrix;
536	glTranslate $self->{x}, $self->{y}, 0;	555	glTranslate $self->{x}, $self->{y}, 0;
537	$self->_draw;
538	glPopMatrix;
539		556
540	if ($self == $HOVER && $self->{can_hover}) {	557	if ($self == $HOVER && $self->{can_hover}) {
541	my ($x, $y) = @$self{qw(x y)};
542
543	glColor 1, 0.8, 0.5, 0.2;	558	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
544	glEnable GL_BLEND;	559	glEnable GL_BLEND;
545	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	560	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
546	glBegin GL_QUADS;	561	glBegin GL_QUADS;
547	glVertex $x , $y;	562	glVertex 0 , 0;
548	glVertex $x + $self->{w}, $y;	563	glVertex $self->{w}, 0;
549	glVertex $x + $self->{w}, $y + $self->{h};	564	glVertex $self->{w}, $self->{h};
550	glVertex $x , $y + $self->{h};	565	glVertex 0 , $self->{h};
551	glEnd;	566	glEnd;
552	glDisable GL_BLEND;	567	glDisable GL_BLEND;
553	}	568	}
554		569
555	if ($ENV{CFPLUS_DEBUG} & 1) {	570	if ($ENV{CFPLUS_DEBUG} & 1) {
556	glPushMatrix;	571	glPushMatrix;
557	glColor 1, 1, 0, 1;	572	glColor 1, 1, 0, 1;
558	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	573	glTranslate 0.375, 0.375;
559	glBegin GL_LINE_LOOP;	574	glBegin GL_LINE_LOOP;
560	glVertex 0 , 0;	575	glVertex 0 , 0;
561	glVertex $self->{w} - 1, 0;	576	glVertex $self->{w} - 1, 0;
562	glVertex $self->{w} - 1, $self->{h} - 1;	577	glVertex $self->{w} - 1, $self->{h} - 1;
563	glVertex 0 , $self->{h} - 1;	578	glVertex 0 , $self->{h} - 1;
564	glEnd;	579	glEnd;
565	glPopMatrix;	580	glPopMatrix;
566	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	581	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
567	}	582	}
		583
		584	$self->_draw;
		585	glPopMatrix;
568	}	586	}
569		587
570	sub _draw {	588	sub _draw {
571	my ($self) = @_;	589	my ($self) = @_;
572		590
…		…
610		628
611	if ($color && (@$color < 4 || $color->[3])) {	629	if ($color && (@$color < 4 || $color->[3])) {
612	my ($w, $h) = @$self{qw(w h)};	630	my ($w, $h) = @$self{qw(w h)};
613		631
614	glEnable GL_BLEND;	632	glEnable GL_BLEND;
615	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	633	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
616	glColor @$color;	634	glColor_premultiply @$color;
617		635
618	glBegin GL_QUADS;	636	glBegin GL_QUADS;
619	glVertex 0 , 0;	637	glVertex 0 , 0;
620	glVertex 0 , $h;	638	glVertex 0 , $h;
621	glVertex $w, $h;	639	glVertex $w, $h;
…		…
652	our @ISA = CFClient::UI::Base::;	670	our @ISA = CFClient::UI::Base::;
653		671
654	sub new {	672	sub new {
655	my ($class, %arg) = @_;	673	my ($class, %arg) = @_;
656		674
657	my $children = delete $arg{children} || [];	675	my $children = delete $arg{children};
658		676
659	my $self = $class->SUPER::new (	677	my $self = $class->SUPER::new (
660	children => [],	678	children => [],
661	can_events => 0,	679	can_events => 0,
662	%arg,	680	%arg,
663	);	681	);
		682
664	$self->add ($_) for @$children;	683	$self->add (@$children)
		684	if $children;
665		685
666	$self	686	$self
667	}	687	}
668		688
669	sub add {	689	sub add {
…		…
717	$x -= $self->{x};	737	$x -= $self->{x};
718	$y -= $self->{y};	738	$y -= $self->{y};
719		739
720	my $res;	740	my $res;
721		741
722	for (reverse @{ $self->{children} }) {	742	for (reverse $self->visible_children) {
723	$res = $_->find_widget ($x, $y)	743	$res = $_->find_widget ($x, $y)
724	and return $res;	744	and return $res;
725	}	745	}
726		746
727	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	747	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
776	$self->{children}[0]->configure (0, 0, $w, $h);	796	$self->{children}[0]->configure (0, 0, $w, $h);
777	}	797	}
778		798
779	#############################################################################	799	#############################################################################
780		800
		801	# back-buffered drawing area
		802
781	package CFClient::UI::Window;	803	package CFClient::UI::Window;
782		804
783	our @ISA = CFClient::UI::Bin::;	805	our @ISA = CFClient::UI::Bin::;
784		806
785	use CFClient::OpenGL;	807	use CFClient::OpenGL;
…		…
803	$self->SUPER::size_allocate ($w, $h);	825	$self->SUPER::size_allocate ($w, $h);
804	$self->update;	826	$self->update;
805	}	827	}
806		828
807	sub _render {	829	sub _render {
		830	my ($self) = @_;
		831
808	$_[0]{children}[0]->draw;	832	$self->{children}[0]->draw;
809	}	833	}
810		834
811	sub render_child {	835	sub render_child {
812	my ($self) = @_;	836	my ($self) = @_;
813		837
814	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	838	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
815	glClearColor 0, 0, 0, 0;	839	glClearColor 0, 0, 0, 0;
816	glClear GL_COLOR_BUFFER_BIT;	840	glClear GL_COLOR_BUFFER_BIT;
817		841
		842	{
		843	package CFClient::UI::Base;
		844
		845	($draw_x, $draw_y, $draw_w, $draw_h) =
		846	(0, 0, $self->{w}, $self->{h});
		847	}
		848
818	$self->_render;	849	$self->_render;
819	};	850	};
820	}	851	}
821		852
822	sub _draw {	853	sub _draw {
823	my ($self) = @_;	854	my ($self) = @_;
824		855
825	my ($w, $h) = ($self->w, $self->h);	856	my ($w, $h) = @$self{qw(w h)};
826		857
827	my $tex = $self->{texture}	858	my $tex = $self->{texture}
828	or return;	859	or return;
829		860
830	glEnable GL_TEXTURE_2D;	861	glEnable GL_TEXTURE_2D;
831	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	862	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
832	glColor 1, 1, 1, 1;	863	glColor 0, 0, 0, 1;
833		864
834	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	865	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
835		866
836	glDisable GL_TEXTURE_2D;	867	glDisable GL_TEXTURE_2D;
837	}	868	}
…		…
913	}	944	}
914		945
915	sub _render {	946	sub _render {
916	my ($self) = @_;	947	my ($self) = @_;
917		948
		949	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		950	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		951
918	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	952	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
919		953
920	$self->SUPER::_render;	954	$self->SUPER::_render;
921	}	955	}
922		956
…		…
925	package CFClient::UI::ScrolledWindow;	959	package CFClient::UI::ScrolledWindow;
926		960
927	our @ISA = CFClient::UI::HBox::;	961	our @ISA = CFClient::UI::HBox::;
928		962
929	sub new {	963	sub new {
930	my $class = shift;	964	my ($class, %arg) = @_;
		965
		966	my $child = delete $arg{child};
931		967
932	my $self;	968	my $self;
933		969
934	my $slider = new CFClient::UI::Slider	970	my $slider = new CFClient::UI::Slider
935	vertical => 1,	971	vertical => 1,
…		…
940	;	976	;
941		977
942	$self = $class->SUPER::new (	978	$self = $class->SUPER::new (
943	vp => (new CFClient::UI::ViewPort expand => 1),	979	vp => (new CFClient::UI::ViewPort expand => 1),
944	slider => $slider,	980	slider => $slider,
945	@_,	981	%arg,
946	);	982	);
947		983
948	$self->{vp}->add ($self->{scrolled});
949	$self->add ($self->{vp});
950	$self->add ($self->{slider});	984	$self->SUPER::add ($self->{vp}, $self->{slider});
		985	$self->add ($child) if $child;
951		986
952	$self	987	$self
		988	}
		989
		990	sub add {
		991	my ($self, $widget) = @_;
		992
		993	$self->{vp}->add ($self->{child} = $widget);
953	}	994	}
954		995
955	sub update {	996	sub update {
956	my ($self) = @_;	997	my ($self) = @_;
957		998
…		…
996		1037
997	if ($self->{bg}) {	1038	if ($self->{bg}) {
998	my ($w, $h) = @$self{qw(w h)};	1039	my ($w, $h) = @$self{qw(w h)};
999		1040
1000	glEnable GL_BLEND;	1041	glEnable GL_BLEND;
1001	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1042	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1002	glColor @{ $self->{bg} };	1043	glColor_premultiply @{ $self->{bg} };
1003		1044
1004	glBegin GL_QUADS;	1045	glBegin GL_QUADS;
1005	glVertex 0 , 0;	1046	glVertex 0 , 0;
1006	glVertex 0 , $h;	1047	glVertex 0 , $h;
1007	glVertex $w, $h;	1048	glVertex $w, $h;
…		…
1029	my @border =	1070	my @border =
1030	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1071	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1031	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1072	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1032		1073
1033	sub new {	1074	sub new {
1034	my $class = shift;	1075	my ($class, %arg) = @_;
		1076
		1077	my $title = delete $arg{title};
1035		1078
1036	my $self = $class->SUPER::new (	1079	my $self = $class->SUPER::new (
1037	bg => [1, 1, 1, 1],	1080	bg => [1, 1, 1, 1],
1038	border_bg => [1, 1, 1, 1],	1081	border_bg => [1, 1, 1, 1],
1039	border => 0.6,	1082	border => 0.6,
1040	can_events => 1,	1083	can_events => 1,
1041	min_w => 16,	1084	min_w => 16,
1042	min_h => 16,	1085	min_h => 16,
1043	@_	1086	%arg,
1044	);	1087	);
1045		1088
1046	$self->{title} &&= new CFClient::UI::Label	1089	$self->{title} = new CFClient::UI::Label
1047	align => 0,	1090	align => 0,
1048	valign => 1,	1091	valign => 1,
1049	text => $self->{title},	1092	text => $title,
1050	fontsize => $self->{border};	1093	fontsize => $self->{border}
		1094	if defined $title;
1051		1095
1052	$self	1096	$self
		1097	}
		1098
		1099	sub add {
		1100	my ($self, @widgets) = @_;
		1101
		1102	$self->SUPER::add (@widgets);
		1103	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
1053	}	1104	}
1054		1105
1055	sub border {	1106	sub border {
1056	int $_[0]{border} * $::FONTSIZE	1107	int $_[0]{border} * $::FONTSIZE
1057	}	1108	}
1058		1109
1059	sub size_request {	1110	sub size_request {
1060	my ($self) = @_;	1111	my ($self) = @_;
		1112
		1113	$self->{title}->size_request
		1114	if $self->{title};
1061		1115
1062	my ($w, $h) = $self->SUPER::size_request;	1116	my ($w, $h) = $self->SUPER::size_request;
1063		1117
1064	(	1118	(
1065	$w + $self->border * 2,	1119	$w + $self->border * 2,
…		…
1068	}	1122	}
1069		1123
1070	sub size_allocate {	1124	sub size_allocate {
1071	my ($self, $w, $h) = @_;	1125	my ($self, $w, $h) = @_;
1072		1126
		1127	if ($self->{title}) {
		1128	$self->{title}{w} = $w;
		1129	$self->{title}{h} = $h;
		1130	$self->{title}->size_allocate ($w, $h);
		1131	}
		1132
		1133	my $border = $self->border;
		1134
1073	$h -= List::Util::max 0, $self->border * 2;	1135	$h -= List::Util::max 0, $border * 2;
1074	$w -= List::Util::max 0, $self->border * 2;	1136	$w -= List::Util::max 0, $border * 2;
1075		1137
1076	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1077	if $self->{title};
1078
1079	$self->child->configure ($self->border, $self->border, $w, $h);	1138	$self->child->configure ($border, $border, $w, $h);
1080	}	1139	}
1081		1140
1082	sub button_down {	1141	sub button_down {
1083	my ($self, $ev, $x, $y) = @_;	1142	my ($self, $ev, $x, $y) = @_;
1084		1143
…		…
1103	my $dy = $ev->{y} - $oy;	1162	my $dy = $ev->{y} - $oy;
1104		1163
1105	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1164	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1106	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1165	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1107		1166
		1167	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1108	$self->realloc;	1168	$self->realloc;
1109	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1110	};	1169	};
1111		1170
1112	} elsif ($lr ^ $td) {	1171	} elsif ($lr ^ $td) {
1113	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1172	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1114	my ($bx, $by) = ($self->{x}, $self->{y});	1173	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1117	my ($ev, $x, $y) = @_;	1176	my ($ev, $x, $y) = @_;
1118		1177
1119	($x, $y) = ($ev->{x}, $ev->{y});	1178	($x, $y) = ($ev->{x}, $ev->{y});
1120		1179
1121	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1180	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
		1181	# HACK: the next line is required to enforce placement
		1182	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});
1122	};	1183	};
		1184	} else {
		1185	return 0;
		1186	}
		1187
1123	}	1188	1
1124	}	1189	}
1125		1190
1126	sub button_up {	1191	sub button_up {
1127	my ($self, $ev, $x, $y) = @_;	1192	my ($self, $ev, $x, $y) = @_;
1128		1193
1129	delete $self->{motion};	1194	!!delete $self->{motion}
1130	}	1195	}
1131		1196
1132	sub mouse_motion {	1197	sub mouse_motion {
1133	my ($self, $ev, $x, $y) = @_;	1198	my ($self, $ev, $x, $y) = @_;
1134		1199
1135	$self->{motion}->($ev, $x, $y) if $self->{motion};	1200	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1201
		1202	!!$self->{motion}
1136	}	1203	}
1137		1204
1138	sub _draw {	1205	sub _draw {
1139	my ($self) = @_;	1206	my ($self) = @_;
1140		1207
		1208	my $child = $self->{children}[0];
		1209
1141	my ($w, $h ) = ($self->{w}, $self->{h});	1210	my ($w, $h ) = ($self->{w}, $self->{h});
1142	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1211	my ($cw, $ch) = ($child->{w}, $child->{h});
1143		1212
1144	glEnable GL_TEXTURE_2D;	1213	glEnable GL_TEXTURE_2D;
1145	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1214	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1146		1215
1147	my $border = $self->border;	1216	my $border = $self->border;
…		…
1162	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1231	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1163	}	1232	}
1164		1233
1165	glDisable GL_TEXTURE_2D;	1234	glDisable GL_TEXTURE_2D;
1166		1235
1167	$self->{title}->draw if $self->{title};
1168
1169	$self->child->draw;	1236	$child->draw;
		1237
		1238	if ($self->{title}) {
		1239	glTranslate 0, $border - $self->{h};
		1240	$self->{title}->_draw;
		1241	}
1170	}	1242	}
1171		1243
1172	#############################################################################	1244	#############################################################################
1173		1245
1174	package CFClient::UI::Table;	1246	package CFClient::UI::Table;
…		…
1467		1539
1468	delete $self->{texture};	1540	delete $self->{texture};
1469	$self->SUPER::update;	1541	$self->SUPER::update;
1470	}	1542	}
1471		1543
		1544	sub realloc {
		1545	my ($self) = @_;
		1546
		1547	delete $self->{ox};
		1548	$self->SUPER::realloc;
		1549	}
		1550
1472	sub set_text {	1551	sub set_text {
1473	my ($self, $text) = @_;	1552	my ($self, $text) = @_;
1474		1553
1475	return if $self->{text} eq "T$text";	1554	return if $self->{text} eq "T$text";
1476	$self->{text} = "T$text";	1555	$self->{text} = "T$text";
1477		1556
1478	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1557	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1479	$self->{layout}->set_text ($text);	1558	$self->{layout}->set_text ($text);
		1559	delete $self->{req_h};
1480		1560
1481	$self->realloc;	1561	$self->realloc;
1482	$self->update;	1562	$self->update;
1483	}	1563	}
1484		1564
…		…
1490		1570
1491	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1571	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1492		1572
1493	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1573	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1494	$self->{layout}->set_markup ($markup);	1574	$self->{layout}->set_markup ($markup);
		1575	delete $self->{req_h};
1495		1576
1496	$self->realloc;	1577	$self->realloc;
1497	$self->update;	1578	$self->update;
1498	}	1579	}
1499		1580
1500	sub size_request {	1581	sub size_request {
1501	my ($self) = @_;	1582	my ($self) = @_;
1502		1583
		1584	if (exists $self->{req_h}) {
		1585	@$self{qw(req_w req_h)}
		1586	} else {
1503	$self->{layout}->set_font ($self->{font}) if $self->{font};	1587	$self->{layout}->set_font ($self->{font}) if $self->{font};
1504	$self->{layout}->set_width ($self->{max_w} || -1);	1588	$self->{layout}->set_width ($self->{max_w} || -1);
1505	$self->{layout}->set_ellipsise ($self->{ellipsise});	1589	$self->{layout}->set_ellipsise ($self->{ellipsise});
1506	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1590	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1507	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1591	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1508		1592
1509	my ($w, $h) = $self->{layout}->size;	1593	my ($w, $h) = $self->{layout}->size;
1510		1594
1511	if (exists $self->{template}) {	1595	if (exists $self->{template}) {
1512	$self->{template}->set_font ($self->{font}) if $self->{font};	1596	$self->{template}->set_font ($self->{font}) if $self->{font};
1513	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1597	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1514		1598
1515	my ($w2, $h2) = $self->{template}->size;	1599	my ($w2, $h2) = $self->{template}->size;
1516		1600
1517	$w = List::Util::max $w, $w2;	1601	$w = List::Util::max $w, $w2;
1518	$h = List::Util::max $h, $h2;	1602	$h = List::Util::max $h, $h2;
1519	}	1603	}
1520		1604
1521	($w, $h)	1605	($w, $h)
		1606	}
1522	}	1607	}
1523		1608
1524	sub size_allocate {	1609	sub size_allocate {
1525	my ($self, $w, $h) = @_;	1610	my ($self, $w, $h) = @_;
1526		1611
		1612	delete $self->{ox};
		1613
1527	delete $self->{texture};	1614	delete $self->{texture}
		1615	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1528	}	1616	}
1529		1617
1530	sub set_fontsize {	1618	sub set_fontsize {
1531	my ($self, $fontsize) = @_;	1619	my ($self, $fontsize) = @_;
1532		1620
…		…
1547	$self->{layout}->set_width ($self->{w});	1635	$self->{layout}->set_width ($self->{w});
1548	$self->{layout}->set_ellipsise ($self->{ellipsise});	1636	$self->{layout}->set_ellipsise ($self->{ellipsise});
1549	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1637	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1550	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1638	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1551		1639
1552	my $tex = new_from_layout CFClient::Texture $self->{layout};	1640	new_from_layout CFClient::Texture $self->{layout}
		1641	};
1553		1642
		1643	unless (exists $self->{ox}) {
1554	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1644	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1555	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1645	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1556	: ($self->{w} - $tex->{w}) * 0.5);	1646	: ($self->{w} - $tex->{w}) * 0.5);
1557		1647
1558	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1648	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1559	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1649	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1560	: ($self->{h} - $tex->{h}) * 0.5);	1650	: ($self->{h} - $tex->{h}) * 0.5);
1561
1562	$tex
1563	};	1651	};
1564		1652
1565	glEnable GL_TEXTURE_2D;	1653	glEnable GL_TEXTURE_2D;
1566	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1654	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1567		1655
		1656	glColor_premultiply @{$self->{fg}}
1568	if ($tex->{format} == GL_ALPHA) {	1657	if $tex->{format} == GL_ALPHA;
1569	glColor @{$self->{fg}};	1658
1570	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1571	} else {
1572	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1659	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1573	}
1574		1660
1575	glDisable GL_TEXTURE_2D;	1661	glDisable GL_TEXTURE_2D;
1576	}	1662	}
1577		1663
1578	#############################################################################	1664	#############################################################################
…		…
1605		1691
1606	delete $self->{cur_h};	1692	delete $self->{cur_h};
1607		1693
1608	return if $self->{text} eq $text;	1694	return if $self->{text} eq $text;
1609		1695
1610	delete $self->{texture};
1611
1612	$self->{last_activity} = $::NOW;	1696	$self->{last_activity} = $::NOW;
1613	$self->{text} = $text;	1697	$self->{text} = $text;
1614		1698
1615	$text =~ s/./*/g if $self->{hidden};	1699	$text =~ s/./*/g if $self->{hidden};
1616	$self->{layout}->set_text ("$text ");	1700	$self->{layout}->set_text ("$text ");
		1701	delete $self->{req_h};
1617		1702
1618	$self->_emit (changed => $self->{text});	1703	$self->_emit (changed => $self->{text});
		1704
		1705	$self->realloc;
		1706	$self->update;
1619	}	1707	}
1620		1708
1621	sub set_text {	1709	sub set_text {
1622	my ($self, $text) = @_;	1710	my ($self, $text) = @_;
1623		1711
1624	$self->{cursor} = length $text;	1712	$self->{cursor} = length $text;
1625	$self->_set_text ($text);	1713	$self->_set_text ($text);
1626
1627	$self->realloc;
1628	}	1714	}
1629		1715
1630	sub get_text {	1716	sub get_text {
1631	$_[0]{text}	1717	$_[0]{text}
1632	}	1718	}
…		…
1662	$self->{cursor} = length $text;	1748	$self->{cursor} = length $text;
1663	} elsif ($uni == 27) {	1749	} elsif ($uni == 27) {
1664	$self->_emit ('escape');	1750	$self->_emit ('escape');
1665	} elsif ($uni) {	1751	} elsif ($uni) {
1666	substr $text, $self->{cursor}++, 0, chr $uni;	1752	substr $text, $self->{cursor}++, 0, chr $uni;
		1753	} else {
		1754	return 0;
1667	}	1755	}
1668		1756
1669	$self->_set_text ($text);	1757	$self->_set_text ($text);
1670		1758
1671	$self->realloc;	1759	$self->realloc;
		1760
		1761	1
1672	}	1762	}
1673		1763
1674	sub focus_in {	1764	sub focus_in {
1675	my ($self) = @_;	1765	my ($self) = @_;
1676		1766
…		…
1691	utf8::encode $text;	1781	utf8::encode $text;
1692	$self->{cursor} = length substr $text, 0, $idx;	1782	$self->{cursor} = length substr $text, 0, $idx;
1693		1783
1694	$self->_set_text ($self->{text});	1784	$self->_set_text ($self->{text});
1695	$self->update;	1785	$self->update;
		1786
		1787	1
1696	}	1788	}
1697		1789
1698	sub mouse_motion {	1790	sub mouse_motion {
1699	my ($self, $ev, $x, $y) = @_;	1791	my ($self, $ev, $x, $y) = @_;
1700	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1792	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1793
		1794	0
1701	}	1795	}
1702		1796
1703	sub _draw {	1797	sub _draw {
1704	my ($self) = @_;	1798	my ($self) = @_;
1705		1799
1706	local $self->{fg} = $self->{fg};	1800	local $self->{fg} = $self->{fg};
1707		1801
1708	if ($FOCUS == $self) {	1802	if ($FOCUS == $self) {
1709	glColor @{$self->{active_bg}};	1803	glColor_premultiply @{$self->{active_bg}};
1710	$self->{fg} = $self->{active_fg};	1804	$self->{fg} = $self->{active_fg};
1711	} else {	1805	} else {
1712	glColor @{$self->{bg}};	1806	glColor_premultiply @{$self->{bg}};
1713	}	1807	}
1714		1808
1715	glEnable GL_BLEND;	1809	glEnable GL_BLEND;
1716	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1810	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1717	glBegin GL_QUADS;	1811	glBegin GL_QUADS;
1718	glVertex 0 , 0;	1812	glVertex 0 , 0;
1719	glVertex 0 , $self->{h};	1813	glVertex 0 , $self->{h};
1720	glVertex $self->{w}, $self->{h};	1814	glVertex $self->{w}, $self->{h};
1721	glVertex $self->{w}, 0;	1815	glVertex $self->{w}, 0;
…		…
1782	} else {	1876	} else {
1783	$self->set_text ($self->{history_saveback});	1877	$self->set_text ($self->{history_saveback});
1784	}	1878	}
1785		1879
1786	} else {	1880	} else {
1787	$self->SUPER::key_down ($ev);	1881	return $self->SUPER::key_down ($ev)
		1882	}
		1883
1788	}	1884	1
1789
1790	}	1885	}
1791		1886
1792	#############################################################################	1887	#############################################################################
1793		1888
1794	package CFClient::UI::Button;	1889	package CFClient::UI::Button;
…		…
1823	my ($self, $ev, $x, $y) = @_;	1918	my ($self, $ev, $x, $y) = @_;
1824		1919
1825	$self->emit ("activate")	1920	$self->emit ("activate")
1826	if $x >= 0 && $x < $self->{w}	1921	if $x >= 0 && $x < $self->{w}
1827	&& $y >= 0 && $y < $self->{h};	1922	&& $y >= 0 && $y < $self->{h};
		1923
		1924	1
1828	}	1925	}
1829		1926
1830	sub _draw {	1927	sub _draw {
1831	my ($self) = @_;	1928	my ($self) = @_;
1832		1929
1833	local $self->{fg} = $self->{fg};	1930	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1834
1835	if ($GRAB == $self) {
1836	$self->{fg} = $self->{active_fg};
1837	}
1838		1931
1839	glEnable GL_TEXTURE_2D;	1932	glEnable GL_TEXTURE_2D;
1840	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1933	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1841	glColor 0, 0, 0, 1;	1934	glColor 0, 0, 0, 1;
1842		1935
…		…
1886		1979
1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	1980	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	1981	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1889	$self->{state} = !$self->{state};	1982	$self->{state} = !$self->{state};
1890	$self->_emit (changed => $self->{state});	1983	$self->_emit (changed => $self->{state});
		1984	} else {
		1985	return 0
		1986	}
		1987
1891	}	1988	1
1892	}	1989	}
1893		1990
1894	sub _draw {	1991	sub _draw {
1895	my ($self) = @_;	1992	my ($self) = @_;
1896		1993
…		…
2063		2160
2064	my $h1 = $self->{h} * (1 - $ycut1);	2161	my $h1 = $self->{h} * (1 - $ycut1);
2065	my $h2 = $self->{h} * (1 - $ycut2);	2162	my $h2 = $self->{h} * (1 - $ycut2);
2066		2163
2067	glEnable GL_BLEND;	2164	glEnable GL_BLEND;
2068	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2165	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2166	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2069	glEnable GL_TEXTURE_2D;	2167	glEnable GL_TEXTURE_2D;
2070	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2168	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2071		2169
2072	glBindTexture GL_TEXTURE_2D, $t1->{name};	2170	glBindTexture GL_TEXTURE_2D, $t1->{name};
2073	glBegin GL_QUADS;	2171	glBegin GL_QUADS;
…		…
2234		2332
2235	$self->SUPER::button_down ($ev, $x, $y);	2333	$self->SUPER::button_down ($ev, $x, $y);
2236		2334
2237	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2335	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2238		2336
2239	$self->mouse_motion ($ev, $x, $y);	2337	$self->mouse_motion ($ev, $x, $y)
2240	}	2338	}
2241		2339
2242	sub mouse_motion {	2340	sub mouse_motion {
2243	my ($self, $ev, $x, $y) = @_;	2341	my ($self, $ev, $x, $y) = @_;
2244		2342
…		…
2248	my (undef, $lo, $hi, $page) = @{$self->{range}};	2346	my (undef, $lo, $hi, $page) = @{$self->{range}};
2249		2347
2250	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2348	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2251		2349
2252	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2350	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2351	} else {
		2352	return 0;
		2353	}
		2354
2253	}	2355	1
2254	}	2356	}
2255		2357
2256	sub update {	2358	sub update {
2257	my ($self) = @_;	2359	my ($self) = @_;
2258		2360
2259	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2361	delete $self->{knob_w};
		2362	$self->SUPER::update;
		2363	}
		2364
		2365	sub _draw {
		2366	my ($self) = @_;
		2367
		2368	unless ($self->{knob_w}) {
2260	$self->set_value ($self->{range}[0]);	2369	$self->set_value ($self->{range}[0]);
2261		2370
2262	my ($value, $lo, $hi, $page) = @{$self->{range}};	2371	my ($value, $lo, $hi, $page) = @{$self->{range}};
2263	my $range = ($hi - $page - $lo) || 1e-100;	2372	my $range = ($hi - $page - $lo) || 1e-100;
2264		2373
…		…
2270	$value = ($value - $lo) / $range;	2379	$value = ($value - $lo) / $range;
2271	$value = $value * $self->{scale} + $self->{offset};	2380	$value = $value * $self->{scale} + $self->{offset};
2272		2381
2273	$self->{knob_x} = $value - $knob_w * 0.5;	2382	$self->{knob_x} = $value - $knob_w * 0.5;
2274	$self->{knob_w} = $knob_w;	2383	$self->{knob_w} = $knob_w;
2275	});	2384	}
2276
2277	$self->SUPER::update;
2278	}
2279
2280	sub _draw {
2281	my ($self) = @_;
2282		2385
2283	$self->SUPER::_draw ();	2386	$self->SUPER::_draw ();
2284		2387
2285	glScale $self->{w}, $self->{h};	2388	glScale $self->{w}, $self->{h};
2286		2389
…		…
2480		2583
2481	delete $self->{texture};	2584	delete $self->{texture};
2482	}	2585	}
2483		2586
2484	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2587	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2485	glClearColor 0.5, 0.5, 0.5, 0;	2588	glClearColor 0, 0, 0, 0;
2486	glClear GL_COLOR_BUFFER_BIT;	2589	glClear GL_COLOR_BUFFER_BIT;
2487		2590
2488	my $top = int $self->{children}[1]{range}[0];	2591	my $top = int $self->{children}[1]{range}[0];
2489		2592
2490	my $y0 = $top;	2593	my $y0 = $top;
…		…
2525	sub _draw {	2628	sub _draw {
2526	my ($self) = @_;	2629	my ($self) = @_;
2527		2630
2528	glEnable GL_TEXTURE_2D;	2631	glEnable GL_TEXTURE_2D;
2529	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2632	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2530	glColor 1, 1, 1, 1;	2633	glColor 0, 0, 0, 1;
2531	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2634	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2532	glDisable GL_TEXTURE_2D;	2635	glDisable GL_TEXTURE_2D;
2533		2636
2534	$self->{children}[1]->draw;	2637	$self->{children}[1]->draw;
2535		2638
2536	}	2639	}
…		…
2763	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2866	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2764		2867
2765	if ($tex) {	2868	if ($tex) {
2766	glEnable GL_TEXTURE_2D;	2869	glEnable GL_TEXTURE_2D;
2767	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2870	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2768	glColor 1, 1, 1, 1;	2871	glColor 0, 0, 0, 1;
2769	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2872	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2770	glDisable GL_TEXTURE_2D;	2873	glDisable GL_TEXTURE_2D;
2771	}	2874	}
2772	}	2875	}
2773		2876
…		…
2780	$self->SUPER::DESTROY;	2883	$self->SUPER::DESTROY;
2781	}	2884	}
2782		2885
2783	#############################################################################	2886	#############################################################################
2784		2887
2785	package CFClient::UI::Inventory;	2888	package CFClient::UI::Buttonbar;
2786		2889
2787	our @ISA = CFClient::UI::ScrolledWindow::;	2890	our @ISA = CFClient::UI::HBox::;
2788		2891
2789	sub new {	2892	# TODO: should actualyl wrap buttons and other goodies.
2790	my $class = shift;
2791
2792	my $self = $class->SUPER::new (
2793	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2794	@_,
2795	);
2796
2797	$self
2798	}
2799
2800	sub set_items {
2801	my ($self, $items) = @_;
2802
2803	$self->{scrolled}->clear;
2804	return unless $items;
2805
2806	my @items = sort {
2807	($a->{type} <=> $b->{type})
2808	or ($a->{name} cmp $b->{name})
2809	} @$items;
2810
2811	$self->{real_items} = \@items;
2812
2813	my $row = 0;
2814	for my $item (@items) {
2815	CFClient::Item::update_widgets $item;
2816
2817	$self->{scrolled}->add (0, $row, $item->{face_widget});
2818	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2819	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2820
2821	$row++;
2822	}
2823	}
2824		2893
2825	#############################################################################	2894	#############################################################################
2826		2895
2827	package CFClient::UI::Menu;	2896	package CFClient::UI::Menu;
2828		2897
…		…
2878	my ($self, $ev, $x, $y) = @_;	2947	my ($self, $ev, $x, $y) = @_;
2879		2948
2880	# TODO: should use vbox->find_widget or so	2949	# TODO: should use vbox->find_widget or so
2881	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2950	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2882	$self->{hover} = $self->{item}{$HOVER};	2951	$self->{hover} = $self->{item}{$HOVER};
		2952
		2953	0
2883	}	2954	}
2884		2955
2885	sub button_up {	2956	sub button_up {
2886	my ($self, $ev, $x, $y) = @_;	2957	my ($self, $ev, $x, $y) = @_;
2887		2958
…		…
2889	undef $GRAB;	2960	undef $GRAB;
2890	$self->hide;	2961	$self->hide;
2891		2962
2892	$self->_emit ("popdown");	2963	$self->_emit ("popdown");
2893	$self->{hover}[1]->() if $self->{hover};	2964	$self->{hover}[1]->() if $self->{hover};
		2965	} else {
		2966	return 0
		2967	}
		2968
2894	}	2969	1
2895	}	2970	}
2896		2971
2897	#############################################################################	2972	#############################################################################
2898		2973
2899	package CFClient::UI::Statusbox;	2974	package CFClient::UI::Multiplexer;
2900		2975
2901	our @ISA = CFClient::UI::VBox::;	2976	our @ISA = CFClient::UI::Container::;
2902		2977
2903	sub new {	2978	sub new {
2904	my $class = shift;	2979	my $class = shift;
2905		2980
2906	$class->SUPER::new (	2981	my $self = $class->SUPER::new (
		2982	@_,
		2983	);
		2984
		2985	$self->{current} = $self->{children}[0]
		2986	if @{ $self->{children} };
		2987
		2988	$self
		2989	}
		2990
		2991	sub add {
		2992	my ($self, @widgets) = @_;
		2993
		2994	$self->SUPER::add (@widgets);
		2995
		2996	$self->{current} = $self->{children}[0]
		2997	if @{ $self->{children} };
		2998	}
		2999
		3000	sub set_current_page {
		3001	my ($self, $page_or_widget) = @_;
		3002
		3003	my $widget = ref $page_or_widget
		3004	? $page_or_widget
		3005	: $self->{children}[$page_or_widget];
		3006
		3007	$self->{current} = $widget;
		3008	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3009
		3010	$self->_emit (page_changed => $self->{current});
		3011
		3012	$self->realloc;
		3013	}
		3014
		3015	sub visible_children {
		3016	$_[0]{current}
		3017	}
		3018
		3019	sub size_request {
		3020	my ($self) = @_;
		3021
		3022	$self->{current}->size_request
		3023	}
		3024
		3025	sub size_allocate {
		3026	my ($self, $w, $h) = @_;
		3027
		3028	$self->{current}->configure (0, 0, $w, $h);
		3029	}
		3030
		3031	sub _draw {
		3032	my ($self) = @_;
		3033
		3034	$self->{current}->draw;
		3035	}
		3036
		3037	#############################################################################
		3038
		3039	package CFClient::UI::Notebook;
		3040
		3041	our @ISA = CFClient::UI::VBox::;
		3042
		3043	sub new {
		3044	my $class = shift;
		3045
		3046	my $self = $class->SUPER::new (
		3047	buttonbar => (new CFClient::UI::Buttonbar),
		3048	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3049	# filter => # will be put between multiplexer and $self
		3050	@_,
		3051	);
		3052
		3053	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3054	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3055
		3056	$self
		3057	}
		3058
		3059	sub add {
		3060	my ($self, $title, $widget, $tooltip) = @_;
		3061
		3062	Scalar::Util::weaken $self;
		3063
		3064	$self->{buttonbar}->add (new CFClient::UI::Button
		3065	markup => $title,
		3066	tooltip => $tooltip,
		3067	on_activate => sub { $self->set_current_page ($widget) },
		3068	);
		3069
		3070	$self->{multiplexer}->add ($widget);
		3071	}
		3072
		3073	sub set_current_page {
		3074	my ($self, $page) = @_;
		3075
		3076	$self->{multiplexer}->set_current_page ($page);
		3077	$self->_emit (page_changed => $self->{multiplexer}{current});
		3078	}
		3079
		3080	#############################################################################
		3081
		3082	package CFClient::UI::Statusbox;
		3083
		3084	our @ISA = CFClient::UI::VBox::;
		3085
		3086	sub new {
		3087	my $class = shift;
		3088
		3089	my $self = $class->SUPER::new (
2907	fontsize => 0.8,	3090	fontsize => 0.8,
2908	@_,	3091	@_,
2909	)	3092	);
		3093
		3094	Scalar::Util::weaken (my $this = $self);
		3095
		3096	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3097
		3098	$self
2910	}	3099	}
2911		3100
2912	sub reorder {	3101	sub reorder {
2913	my ($self) = @_;	3102	my ($self) = @_;
2914	my $NOW = time;	3103	my $NOW = Time::HiRes::time;
		3104
		3105	# freeze display when hovering over any label
		3106	return if $CFClient::UI::TOOLTIP->{owner}
		3107	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3108	values %{ $self->{item} };
2915		3109
2916	while (my ($k, $v) = each %{ $self->{item} }) {	3110	while (my ($k, $v) = each %{ $self->{item} }) {
2917	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3111	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2918	}	3112	}
2919		3113
…		…
2922	my @items = sort {	3116	my @items = sort {
2923	$a->{pri} <=> $b->{pri}	3117	$a->{pri} <=> $b->{pri}
2924	or $b->{id} <=> $a->{id}	3118	or $b->{id} <=> $a->{id}
2925	} values %{ $self->{item} };	3119	} values %{ $self->{item} };
2926		3120
		3121	$self->{timer}->interval (1);
		3122
2927	my $count = 10 + 1;	3123	my $count = 10 + 1;
2928	for my $item (@items) {	3124	for my $item (@items) {
2929	last unless --$count;	3125	last unless --$count;
2930		3126
2931	push @widgets, $item->{label} ||= do {	3127	my $label = $item->{label} ||= do {
2932	# TODO: doesn't handle markup well (read as: at all)	3128	# TODO: doesn't handle markup well (read as: at all)
2933	my $short = $item->{count} > 1	3129	my $short = $item->{count} > 1
2934	? "<b>$item->{count} ×</b> $item->{text}"	3130	? "<b>$item->{count} ×</b> $item->{text}"
2935	: $item->{text};	3131	: $item->{text};
2936		3132
…		…
2944	tooltip => $item->{tooltip},	3140	tooltip => $item->{tooltip},
2945	tooltip_font => $::FONT_PROP,	3141	tooltip_font => $::FONT_PROP,
2946	tooltip_width => 0.67,	3142	tooltip_width => 0.67,
2947	fontsize => $item->{fontsize} || $self->{fontsize},	3143	fontsize => $item->{fontsize} || $self->{fontsize},
2948	max_w => $::WIDTH * 0.44,	3144	max_w => $::WIDTH * 0.44,
2949	fg => $item->{fg},	3145	fg => [@{ $item->{fg} }],
2950	can_events => 1,	3146	can_events => 1,
2951	can_hover => 1	3147	can_hover => 1
2952	};	3148	};
		3149
		3150	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3151	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3152	$label->update;
		3153	$label->set_max_size (undef, $label->{req_h} * $diff)
		3154	if $diff < 1;
		3155	$self->{timer}->interval (1/30);
		3156	} else {
		3157	$label->{fg}[3] = $item->{fg}[3] || 1;
		3158	}
		3159
		3160	push @widgets, $label;
2953	}	3161	}
2954		3162
2955	$self->clear;	3163	$self->clear;
2956	$self->SUPER::add (reverse @widgets);	3164	$self->SUPER::add (reverse @widgets);
2957	}	3165	}
…		…
2962	$text =~ s/^\s+//;	3170	$text =~ s/^\s+//;
2963	$text =~ s/\s+$//;	3171	$text =~ s/\s+$//;
2964		3172
2965	return unless $text;	3173	return unless $text;
2966		3174
2967	my $timeout = time + ((delete $arg{timeout}) || 60);	3175	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2968		3176
2969	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3177	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2970		3178
2971	if (my $item = $self->{item}{$group}) {	3179	if (my $item = $self->{item}{$group}) {
2972	if ($item->{text} eq $text) {	3180	if ($item->{text} eq $text) {
…		…
3002		3210
3003	$self->reorder;	3211	$self->reorder;
3004	$self->SUPER::reconfigure;	3212	$self->SUPER::reconfigure;
3005	}	3213	}
3006		3214
		3215	sub DESTROY {
		3216	my ($self) = @_;
		3217
		3218	$self->{timer}->cancel;
		3219
		3220	$self->SUPER::DESTROY;
		3221	}
		3222
3007	#############################################################################	3223	#############################################################################
3008		3224
3009	package CFClient::UI::Root;	3225	package CFClient::UI::Inventory;
3010		3226
3011	our @ISA = CFClient::UI::Container::;	3227	our @ISA = CFClient::UI::ScrolledWindow::;
3012
3013	use CFClient::OpenGL;
3014		3228
3015	sub new {	3229	sub new {
3016	my $class = shift;	3230	my $class = shift;
3017		3231
3018	my $self = $class->SUPER::new (	3232	my $self = $class->SUPER::new (
3019	visible => 1,	3233	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3020	@_,	3234	@_,
3021	);	3235	);
3022		3236
3023	Scalar::Util::weaken ($self->{root} = $self);
3024
3025	$self	3237	$self
3026	}	3238	}
3027		3239
3028	sub size_request {	3240	sub set_items {
3029	my ($self) = @_;	3241	my ($self, $items) = @_;
3030		3242
3031	($self->{w}, $self->{h})	3243	$self->{child}->clear;
3032	}	3244	return unless $items;
3033		3245
3034	sub _to_pixel {	3246	my @items = sort {
3035	my ($coord, $size, $max) = @_;	3247	($a->{type} <=> $b->{type})
		3248	or ($a->{name} cmp $b->{name})
		3249	} @$items;
3036		3250
3037	$coord =	3251	$self->{real_items} = \@items;
3038	$coord eq "center" ? ($max - $size) * 0.5
3039	: $coord eq "max" ? $max
3040	: $coord;
3041		3252
3042	$coord = 0 if $coord < 0;	3253	my $row = 0;
3043	$coord = $max - $size if $coord > $max - $size;	3254	for my $item (@items) {
		3255	CFClient::Item::update_widgets $item;
3044		3256
3045	int $coord + 0.5	3257	$self->{child}->add (0, $row, $item->{face_widget});
3046	}	3258	$self->{child}->add (1, $row, $item->{desc_widget});
		3259	$self->{child}->add (2, $row, $item->{weight_widget});
3047		3260
3048	sub size_allocate {	3261	$row++;
3049	my ($self, $w, $h) = @_;
3050
3051	for my $child ($self->children) {
3052	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3053
3054	$X = $child->{force_x} if exists $child->{force_x};
3055	$Y = $child->{force_y} if exists $child->{force_y};
3056
3057	$X = _to_pixel $X, $W, $self->{w};
3058	$Y = _to_pixel $Y, $H, $self->{h};
3059
3060	$child->configure ($X, $Y, $W, $H);
3061	}	3262	}
3062	}
3063
3064	sub coord2local {
3065	my ($self, $x, $y) = @_;
3066
3067	($x, $y)
3068	}
3069
3070	sub coord2global {
3071	my ($self, $x, $y) = @_;
3072
3073	($x, $y)
3074	}
3075
3076	sub update {
3077	my ($self) = @_;
3078
3079	$::WANT_REFRESH++;
3080	}
3081
3082	sub add {
3083	my ($self, @children) = @_;
3084
3085	$_->{is_toplevel} = 1
3086	for @children;
3087
3088	$self->SUPER::add (@children);
3089	}
3090
3091	sub remove {
3092	my ($self, @children) = @_;
3093
3094	$self->SUPER::remove (@children);
3095
3096	delete $self->{is_toplevel}
3097	for @children;
3098
3099	while (@children) {
3100	my $w = pop @children;
3101	push @children, $w->children;
3102	$w->set_invisible;
3103	}
3104	}
3105
3106	sub on_refresh {
3107	my ($self, $id, $cb) = @_;
3108
3109	$self->{refresh_hook}{$id} = $cb;
3110	}
3111
3112	sub on_post_alloc {
3113	my ($self, $id, $cb) = @_;
3114
3115	$self->{post_alloc_hook}{$id} = $cb;
3116	}
3117
3118	sub draw {
3119	my ($self) = @_;
3120
3121	while ($self->{refresh_hook}) {
3122	$_->()
3123	for values %{delete $self->{refresh_hook}};
3124	}
3125
3126	if ($self->{realloc}) {
3127	my @queue;
3128
3129	while () {
3130	if ($self->{realloc}) {
3131	#TODO use array-of-depth approach
3132
3133	use sort 'stable';
3134
3135	@queue = sort { $a->{visible} <=> $b->{visible} }
3136	@queue, values %{delete $self->{realloc}};
3137	}
3138
3139	my $widget = pop @queue || last;
3140
3141	$widget->{visible} or last; # do not resize invisible widgets
3142
3143	my ($w, $h) = $widget->size_request;
3144
3145	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3146	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3147
3148	$w = $widget->{force_w} if exists $widget->{force_w};
3149	$h = $widget->{force_h} if exists $widget->{force_h};
3150
3151	if ($widget->{req_w} != $w || $widget->{req_h} != $h
3152	|| delete $widget->{force_realloc}) {
3153	$widget->{req_w} = $w;
3154	$widget->{req_h} = $h;
3155
3156	$self->{size_alloc}{$widget+0} = $widget;
3157
3158	if (my $parent = $widget->{parent}) {
3159	$self->{realloc}{$parent+0} = $parent;
3160	#unshift @queue, $parent;
3161	$parent->{force_size_alloc} = 1;
3162	$self->{size_alloc}{$parent+0} = $parent;
3163	}
3164	}
3165
3166	delete $self->{realloc}{$widget+0};
3167	}
3168	}
3169
3170	while (my $size_alloc = delete $self->{size_alloc}) {
3171	my @queue = sort { $b->{visible} <=> $a->{visible} }
3172	values %$size_alloc;
3173
3174	while () {
3175	my $widget = pop @queue || last;
3176
3177	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3178
3179	$w = 0 if $w < 0;
3180	$h = 0 if $h < 0;
3181
3182	$w = int $w + 0.5;
3183	$h = int $h + 0.5;
3184
3185	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3186	$widget->{w} = $w;
3187	$widget->{h} = $h;
3188
3189	$widget->emit (size_allocate => $w, $h);
3190	}
3191	}
3192	}
3193
3194	while ($self->{post_alloc_hook}) {
3195	$_->()
3196	for values %{delete $self->{post_alloc_hook}};
3197	}
3198
3199
3200	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3201	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3202	glClear GL_COLOR_BUFFER_BIT;
3203
3204	glMatrixMode GL_PROJECTION;
3205	glLoadIdentity;
3206	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3207	glMatrixMode GL_MODELVIEW;
3208	glLoadIdentity;
3209
3210	$self->_draw;
3211	}	3263	}
3212		3264
3213	#############################################################################	3265	#############################################################################
3214		3266
3215	package CFClient::UI::BindEditor;	3267	package CFClient::UI::BindEditor;
…		…
3221		3273
3222	my $self = $class->SUPER::new (binding => [], commands => [], @_);	3274	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3223		3275
3224	$self->add (my $vb = new CFClient::UI::VBox);	3276	$self->add (my $vb = new CFClient::UI::VBox);
3225		3277
3226	$vb->add (my $hb = new CFClient::UI::HBox);
3227	$hb->add (new CFClient::UI::Label text => "Key: ");
3228	$hb->add ($self->{keylbl} = new CFClient::UI::Label);
3229	$hb->add (new CFClient::UI::Button
3230	text => "bind",
3231	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3232	on_activate => sub {
3233	$self->ask_for_bind;
3234	});
3235		3278
3236	$vb->add (new CFClient::UI::Label text => "Actions:");
3237	$vb->add ($self->{rec_btn} = new CFClient::UI::Button	3279	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3238	text => "start recording",	3280	text => "start recording",
3239	tooltip => "Start/Stops recording of actions."	3281	tooltip => "Start/Stops recording of actions."
3240	."All subsequent actions after the recording started will be captured."	3282	."All subsequent actions after the recording started will be captured."
3241	."The actions are displayed after the record was stopped."	3283	."The actions are displayed after the record was stopped."
…		…
3246	} else {	3288	} else {
3247	$self->stop;	3289	$self->stop;
3248	}	3290	}
3249	});	3291	});
3250		3292
		3293	$vb->add (new CFClient::UI::Label text => "Actions:");
3251	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);	3294	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3295
		3296	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3297	$vb->add (my $hb = new CFClient::UI::HBox);
		3298	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3299	$hb->add (new CFClient::UI::Button
		3300	text => "bind",
		3301	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3302	on_activate => sub {
		3303	$self->ask_for_bind;
		3304	});
3252		3305
3253	$vb->add (my $hb = new CFClient::UI::HBox);	3306	$vb->add (my $hb = new CFClient::UI::HBox);
3254	$hb->add (new CFClient::UI::Button	3307	$hb->add (new CFClient::UI::Button
3255	text => "ok",	3308	text => "ok",
		3309	expand => 1,
3256	tooltip => "This closes the binding editor and saves the binding",	3310	tooltip => "This closes the binding editor and saves the binding",
3257	on_activate => sub {	3311	on_activate => sub {
3258	$self->hide;	3312	$self->hide;
3259	$self->commit;	3313	$self->commit;
3260	});	3314	});
3261		3315
3262	$hb->add (new CFClient::UI::Button	3316	$hb->add (new CFClient::UI::Button
3263	text => "cancel",	3317	text => "cancel",
		3318	expand => 1,
3264	tooltip => "This closes the binding editor without saving",	3319	tooltip => "This closes the binding editor without saving",
3265	on_activate => sub {	3320	on_activate => sub {
3266	$self->hide;	3321	$self->hide;
3267	$self->{binding_cancel}->()	3322	$self->{binding_cancel}->()
3268	if $self->{binding_cancel};	3323	if $self->{binding_cancel};
…		…
3280	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)	3335	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3281	."'. Don't forget 'Save Config'!");	3336	."'. Don't forget 'Save Config'!");
3282	$self->{binding_change}->($mod, $sym, $cmds)	3337	$self->{binding_change}->($mod, $sym, $cmds)
3283	if $self->{binding_change};	3338	if $self->{binding_change};
3284	} else {	3339	} else {
3285	$::STATUSBOX->add ("No action bound, no keys specified!");	3340	$::STATUSBOX->add ("No action bound, no key or action specified!");
3286	$self->{binding_cancel}->()	3341	$self->{binding_cancel}->()
3287	if $self->{binding_cancel};	3342	if $self->{binding_cancel};
3288	}	3343	}
3289	}	3344	}
3290		3345
…		…
3305		3360
3306	my $rec;	3361	my $rec;
3307	$rec = $::CONN->stop_record if $::CONN;	3362	$rec = $::CONN->stop_record if $::CONN;
3308	return unless ref $rec eq 'ARRAY';	3363	return unless ref $rec eq 'ARRAY';
3309	$self->set_command_list ($rec);	3364	$self->set_command_list ($rec);
		3365	}
		3366
		3367
		3368	sub ask_for_bind_and_commit {
		3369	my ($self) = @_;
		3370	$self->ask_for_bind (1);
3310	}	3371	}
3311		3372
3312	sub ask_for_bind {	3373	sub ask_for_bind {
3313	my ($self, $commit) = @_;	3374	my ($self, $commit) = @_;
3314		3375
…		…
3318	$self->update_binding_widgets;	3379	$self->update_binding_widgets;
3319	$self->commit if $commit;	3380	$self->commit if $commit;
3320	});	3381	});
3321	}	3382	}
3322		3383
		3384	# $mod and $sym are the modifiers and key symbol
		3385	# $cmds is a array ref of strings (the commands)
		3386	# $cb is the callback that is executed on OK
		3387	# $ccb is the callback that is executed on CANCEL and
		3388	# when the binding was unsuccessful on OK
3323	sub set_binding {	3389	sub set_binding {
3324	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;	3390	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3325		3391
3326	$self->clear_command_list;	3392	$self->clear_command_list;
3327	$self->{recording} = 0;	3393	$self->{recording} = 0;
…		…
3332		3398
3333	$self->{binding_change} = $cb;	3399	$self->{binding_change} = $cb;
3334	$self->{binding_cancel} = $ccb;	3400	$self->{binding_cancel} = $ccb;
3335		3401
3336	$self->update_binding_widgets;	3402	$self->update_binding_widgets;
		3403	}
		3404
		3405	# this is a shortcut method that asks for a binding
		3406	# and then just binds it.
		3407	sub do_quick_binding {
		3408	my ($self, $cmds) = @_;
		3409	$self->set_binding (undef, undef, $cmds, sub {
		3410	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3411	});
		3412	$self->ask_for_bind (1);
3337	}	3413	}
3338		3414
3339	sub update_binding_widgets {	3415	sub update_binding_widgets {
3340	my ($self) = @_;	3416	my ($self) = @_;
3341	my ($mod, $sym, $cmds) = $self->get_binding;	3417	my ($mod, $sym, $cmds) = $self->get_binding;
…		…
3367		3443
3368	for (@$cmds) {	3444	for (@$cmds) {
3369	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);	3445	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3370		3446
3371	my $i = $idx;	3447	my $i = $idx;
		3448	$hb->add (new CFClient::UI::Label text => $_);
3372	$hb->add (new CFClient::UI::Button	3449	$hb->add (new CFClient::UI::Button
3373	text => "delete",	3450	text => "delete",
3374	tooltip => "Deletes the action from the record",	3451	tooltip => "Deletes the action from the record",
3375	on_activate => sub {	3452	on_activate => sub {
3376	$self->{cmdbox}->remove ($hb);	3453	$self->{cmdbox}->remove ($hb);
3377	$cmds->[$i] = undef;	3454	$cmds->[$i] = undef;
3378	});	3455	});
3379		3456
3380	$hb->add (new CFClient::UI::Label text => $_);
3381		3457
3382	$idx++	3458	$idx++
3383	}	3459	}
3384	}	3460	}
3385		3461
		3462	#############################################################################
		3463
		3464	package CFClient::UI::SpellList;
		3465
		3466	our @ISA = CFClient::UI::Table::;
		3467
		3468	sub new {
		3469	my $class = shift;
		3470
		3471	my $self = $class->SUPER::new (
		3472	binding => [],
		3473	commands => [],
		3474	@_,
		3475	)
		3476	}
		3477
		3478	# XXX: Do sorting? Argl...
		3479	sub add_spell {
		3480	my ($self, $spell) = @_;
		3481	$self->{spells}->{$spell->{name}} = $spell;
		3482
		3483	$self->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3484	face => $spell->{face},
		3485	can_hover => 1,
		3486	can_events => 1,
		3487	tooltip => $spell->{message});
		3488
		3489	$self->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3490	text => $spell->{name},
		3491	can_hover => 1,
		3492	can_events => 1,
		3493	tooltip => $spell->{message},
		3494	expand => 1);
		3495
		3496	$self->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3497	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3498	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3499	expand => 1);
		3500
		3501	$self->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3502	text => "bind to key",
		3503	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3504	}
		3505
		3506	sub rebuild_spell_list {
		3507	my ($self) = @_;
		3508	$self->{tbl_idx} = 0;
		3509	$self->add_spell ($_) for values %{$self->{spells}};
		3510	}
		3511
		3512	sub remove_spell {
		3513	my ($self, $spell) = @_;
		3514	delete $self->{spells}->{$spell->{name}};
		3515	$self->rebuild_spell_list;
		3516	}
		3517
		3518	#############################################################################
		3519
		3520	package CFClient::UI::Root;
		3521
		3522	our @ISA = CFClient::UI::Container::;
		3523
		3524	use List::Util qw(min max);
		3525
		3526	use CFClient::OpenGL;
		3527
		3528	sub new {
		3529	my $class = shift;
		3530
		3531	my $self = $class->SUPER::new (
		3532	visible => 1,
		3533	@_,
		3534	);
		3535
		3536	Scalar::Util::weaken ($self->{root} = $self);
		3537
		3538	$self
		3539	}
		3540
		3541	sub size_request {
		3542	my ($self) = @_;
		3543
		3544	($self->{w}, $self->{h})
		3545	}
		3546
		3547	sub _to_pixel {
		3548	my ($coord, $size, $max) = @_;
		3549
		3550	$coord =
		3551	$coord eq "center" ? ($max - $size) * 0.5
		3552	: $coord eq "max" ? $max
		3553	: $coord;
		3554
		3555	$coord = 0 if $coord < 0;
		3556	$coord = $max - $size if $coord > $max - $size;
		3557
		3558	int $coord + 0.5
		3559	}
		3560
		3561	sub size_allocate {
		3562	my ($self, $w, $h) = @_;
		3563
		3564	for my $child ($self->children) {
		3565	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
		3566
		3567	$X = $child->{force_x} if exists $child->{force_x};
		3568	$Y = $child->{force_y} if exists $child->{force_y};
		3569
		3570	$X = _to_pixel $X, $W, $self->{w};
		3571	$Y = _to_pixel $Y, $H, $self->{h};
		3572
		3573	$child->configure ($X, $Y, $W, $H);
		3574	}
		3575	}
		3576
		3577	sub coord2local {
		3578	my ($self, $x, $y) = @_;
		3579
		3580	($x, $y)
		3581	}
		3582
		3583	sub coord2global {
		3584	my ($self, $x, $y) = @_;
		3585
		3586	($x, $y)
		3587	}
		3588
		3589	sub update {
		3590	my ($self) = @_;
		3591
		3592	$::WANT_REFRESH++;
		3593	}
		3594
		3595	sub add {
		3596	my ($self, @children) = @_;
		3597
		3598	$_->{is_toplevel} = 1
		3599	for @children;
		3600
		3601	$self->SUPER::add (@children);
		3602	}
		3603
		3604	sub remove {
		3605	my ($self, @children) = @_;
		3606
		3607	$self->SUPER::remove (@children);
		3608
		3609	delete $self->{is_toplevel}
		3610	for @children;
		3611
		3612	while (@children) {
		3613	my $w = pop @children;
		3614	push @children, $w->children;
		3615	$w->set_invisible;
		3616	}
		3617	}
		3618
		3619	sub on_refresh {
		3620	my ($self, $id, $cb) = @_;
		3621
		3622	$self->{refresh_hook}{$id} = $cb;
		3623	}
		3624
		3625	sub on_post_alloc {
		3626	my ($self, $id, $cb) = @_;
		3627
		3628	$self->{post_alloc_hook}{$id} = $cb;
		3629	}
		3630
		3631	sub draw {
		3632	my ($self) = @_;
		3633
		3634	while ($self->{refresh_hook}) {
		3635	$_->()
		3636	for values %{delete $self->{refresh_hook}};
		3637	}
		3638
		3639	if ($self->{realloc}) {
		3640	my %queue;
		3641	my @queue;
		3642	my $widget;
		3643
		3644	outer:
		3645	while () {
		3646	if (my $realloc = delete $self->{realloc}) {
		3647	for $widget (values %$realloc) {
		3648	$widget->{visible} or next; # do not resize invisible widgets
		3649
		3650	$queue{$widget+0}++ and next; # duplicates are common
		3651
		3652	push @{ $queue[$widget->{visible}] }, $widget;
		3653	}
		3654	}
		3655
		3656	while () {
		3657	@queue or last outer;
		3658
		3659	$widget = pop @{ $queue[-1] || [] }
		3660	and last;
		3661
		3662	pop @queue;
		3663	}
		3664
		3665	delete $queue{$widget+0};
		3666
		3667	my ($w, $h) = $widget->size_request;
		3668
		3669	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3670	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3671
		3672	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3673	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3674
		3675	$w = $widget->{force_w} if exists $widget->{force_w};
		3676	$h = $widget->{force_h} if exists $widget->{force_h};
		3677
		3678	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3679	|| delete $widget->{force_realloc}) {
		3680	$widget->{req_w} = $w;
		3681	$widget->{req_h} = $h;
		3682
		3683	$self->{size_alloc}{$widget+0} = $widget;
		3684
		3685	if (my $parent = $widget->{parent}) {
		3686	$self->{realloc}{$parent+0} = $parent
		3687	unless $queue{$parent+0};
		3688
		3689	$parent->{force_size_alloc} = 1;
		3690	$self->{size_alloc}{$parent+0} = $parent;
		3691	}
		3692	}
		3693
		3694	delete $self->{realloc}{$widget+0};
		3695	}
		3696	}
		3697
		3698	while (my $size_alloc = delete $self->{size_alloc}) {
		3699	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3700	values %$size_alloc;
		3701
		3702	while () {
		3703	my $widget = pop @queue || last;
		3704
		3705	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
		3706
		3707	$w = 0 if $w < 0;
		3708	$h = 0 if $h < 0;
		3709
		3710	$w = int $w + 0.5;
		3711	$h = int $h + 0.5;
		3712
		3713	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3714	$widget->{old_w} = $widget->{w};
		3715	$widget->{old_h} = $widget->{h};
		3716
		3717	$widget->{w} = $w;
		3718	$widget->{h} = $h;
		3719
		3720	$widget->emit (size_allocate => $w, $h);
		3721	}
		3722	}
		3723	}
		3724
		3725	while ($self->{post_alloc_hook}) {
		3726	$_->()
		3727	for values %{delete $self->{post_alloc_hook}};
		3728	}
		3729
		3730
		3731	glViewport 0, 0, $::WIDTH, $::HEIGHT;
		3732	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
		3733	glClear GL_COLOR_BUFFER_BIT;
		3734
		3735	glMatrixMode GL_PROJECTION;
		3736	glLoadIdentity;
		3737	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
		3738	glMatrixMode GL_MODELVIEW;
		3739	glLoadIdentity;
		3740
		3741	{
		3742	package CFClient::UI::Base;
		3743
		3744	($draw_x, $draw_y, $draw_w, $draw_h) =
		3745	(0, 0, $self->{w}, $self->{h});
		3746	}
		3747
		3748	$self->_draw;
		3749	}
3386		3750
3387	#############################################################################	3751	#############################################################################
3388		3752
3389	package CFClient::UI;	3753	package CFClient::UI;
3390		3754

Diff Legend

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