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.259 by root, Tue May 30 07:13:09 2006 UTC vs.
Revision 1.296 by root, Wed Jun 7 05:48:53 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);
…		…
313	}	315	}
314		316
315	sub move_abs {	317	sub move_abs {
316	my ($self, $x, $y, $z) = @_;	318	my ($self, $x, $y, $z) = @_;
317		319
318	$self->{x} = List::Util::max 0, int $x;	320	$self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
319	$self->{y} = List::Util::max 0, int $y;	321	$self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
320	$self->{z} = $z if defined $z;	322	$self->{z} = $z if defined $z;
321		323
322	$self->update;	324	$self->update;
323	}	325	}
324		326
…		…
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);
1480		1559
		1560	delete $self->{size_req};
1481	$self->realloc;	1561	$self->realloc;
1482	$self->update;	1562	$self->update;
1483	}	1563	}
1484		1564
1485	sub set_markup {	1565	sub set_markup {
…		…
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);
1495		1575
		1576	delete $self->{size_req};
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	$self->{size_req} ||= do {
1503	$self->{layout}->set_font ($self->{font}) if $self->{font};	1585	$self->{layout}->set_font ($self->{font}) if $self->{font};
1504	$self->{layout}->set_width ($self->{max_w} || -1);	1586	$self->{layout}->set_width ($self->{max_w} || -1);
1505	$self->{layout}->set_ellipsise ($self->{ellipsise});	1587	$self->{layout}->set_ellipsise ($self->{ellipsise});
1506	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1588	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1507	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1589	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1508		1590
1509	my ($w, $h) = $self->{layout}->size;	1591	my ($w, $h) = $self->{layout}->size;
1510		1592
1511	if (exists $self->{template}) {	1593	if (exists $self->{template}) {
1512	$self->{template}->set_font ($self->{font}) if $self->{font};	1594	$self->{template}->set_font ($self->{font}) if $self->{font};
1513	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1595	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1514		1596
1515	my ($w2, $h2) = $self->{template}->size;	1597	my ($w2, $h2) = $self->{template}->size;
1516		1598
1517	$w = List::Util::max $w, $w2;	1599	$w = List::Util::max $w, $w2;
1518	$h = List::Util::max $h, $h2;	1600	$h = List::Util::max $h, $h2;
		1601	}
		1602
		1603	[$w, $h]
1519	}	1604	};
1520		1605
1521	($w, $h)	1606	@{ $self->{size_req} }
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
1533	$self->{fontsize} = $fontsize;	1621	$self->{fontsize} = $fontsize;
1534	delete $self->{texture};	1622	delete $self->{texture};
1535		1623
1536	$self->realloc;	1624	$self->realloc;
		1625	}
		1626
		1627	sub reconfigure {
		1628	my ($self) = @_;
		1629
		1630	delete $self->{size_req};
		1631
		1632	$self->SUPER::reconfigure;
1537	}	1633	}
1538		1634
1539	sub _draw {	1635	sub _draw {
1540	my ($self) = @_;	1636	my ($self) = @_;
1541		1637
…		…
1547	$self->{layout}->set_width ($self->{w});	1643	$self->{layout}->set_width ($self->{w});
1548	$self->{layout}->set_ellipsise ($self->{ellipsise});	1644	$self->{layout}->set_ellipsise ($self->{ellipsise});
1549	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1645	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1550	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1646	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1551		1647
1552	my $tex = new_from_layout CFClient::Texture $self->{layout};	1648	new_from_layout CFClient::Texture $self->{layout}
		1649	};
1553		1650
		1651	unless (exists $self->{ox}) {
1554	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1652	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1555	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1653	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1556	: ($self->{w} - $tex->{w}) * 0.5);	1654	: ($self->{w} - $tex->{w}) * 0.5);
1557		1655
1558	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1656	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1559	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1657	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1560	: ($self->{h} - $tex->{h}) * 0.5);	1658	: ($self->{h} - $tex->{h}) * 0.5);
1561
1562	$tex
1563	};	1659	};
1564		1660
1565	glEnable GL_TEXTURE_2D;	1661	glEnable GL_TEXTURE_2D;
1566	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1662
		1663	my $w = List::Util::min $self->{w} + 4, $tex->{w};
		1664	my $h = List::Util::min $self->{h} + 2, $tex->{h};
1567		1665
1568	if ($tex->{format} == GL_ALPHA) {	1666	if ($tex->{format} == GL_ALPHA) {
		1667	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1569	glColor @{$self->{fg}};	1668	glColor @{$self->{fg}};
1570	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1669	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1571	} else {	1670	} else {
		1671	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1572	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1672	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1573	}	1673	}
1574		1674
1575	glDisable GL_TEXTURE_2D;	1675	glDisable GL_TEXTURE_2D;
1576	}	1676	}
1577		1677
…		…
1594	can_hover => 1,	1694	can_hover => 1,
1595	can_focus => 1,	1695	can_focus => 1,
1596	valign => 0,	1696	valign => 0,
1597	can_events => 1,	1697	can_events => 1,
1598	#text => ...	1698	#text => ...
		1699	#hidden => "*",
1599	@_	1700	@_
1600	)	1701	)
1601	}	1702	}
1602		1703
1603	sub _set_text {	1704	sub _set_text {
…		…
1605		1706
1606	delete $self->{cur_h};	1707	delete $self->{cur_h};
1607		1708
1608	return if $self->{text} eq $text;	1709	return if $self->{text} eq $text;
1609		1710
1610	delete $self->{texture};
1611
1612	$self->{last_activity} = $::NOW;	1711	$self->{last_activity} = $::NOW;
1613	$self->{text} = $text;	1712	$self->{text} = $text;
1614		1713
1615	$text =~ s/./*/g if $self->{hidden};	1714	$text =~ s/./*/g if $self->{hidden};
1616	$self->{layout}->set_text ("$text ");	1715	$self->{layout}->set_text ("$text ");
		1716	delete $self->{size_req};
1617		1717
1618	$self->_emit (changed => $self->{text});	1718	$self->_emit (changed => $self->{text});
		1719
		1720	$self->realloc;
		1721	$self->update;
1619	}	1722	}
1620		1723
1621	sub set_text {	1724	sub set_text {
1622	my ($self, $text) = @_;	1725	my ($self, $text) = @_;
1623		1726
1624	$self->{cursor} = length $text;	1727	$self->{cursor} = length $text;
1625	$self->_set_text ($text);	1728	$self->_set_text ($text);
1626
1627	$self->realloc;
1628	}	1729	}
1629		1730
1630	sub get_text {	1731	sub get_text {
1631	$_[0]{text}	1732	$_[0]{text}
1632	}	1733	}
…		…
1662	$self->{cursor} = length $text;	1763	$self->{cursor} = length $text;
1663	} elsif ($uni == 27) {	1764	} elsif ($uni == 27) {
1664	$self->_emit ('escape');	1765	$self->_emit ('escape');
1665	} elsif ($uni) {	1766	} elsif ($uni) {
1666	substr $text, $self->{cursor}++, 0, chr $uni;	1767	substr $text, $self->{cursor}++, 0, chr $uni;
		1768	} else {
		1769	return 0;
1667	}	1770	}
1668		1771
1669	$self->_set_text ($text);	1772	$self->_set_text ($text);
1670		1773
1671	$self->realloc;	1774	$self->realloc;
		1775
		1776	1
1672	}	1777	}
1673		1778
1674	sub focus_in {	1779	sub focus_in {
1675	my ($self) = @_;	1780	my ($self) = @_;
1676		1781
…		…
1691	utf8::encode $text;	1796	utf8::encode $text;
1692	$self->{cursor} = length substr $text, 0, $idx;	1797	$self->{cursor} = length substr $text, 0, $idx;
1693		1798
1694	$self->_set_text ($self->{text});	1799	$self->_set_text ($self->{text});
1695	$self->update;	1800	$self->update;
		1801
		1802	1
1696	}	1803	}
1697		1804
1698	sub mouse_motion {	1805	sub mouse_motion {
1699	my ($self, $ev, $x, $y) = @_;	1806	my ($self, $ev, $x, $y) = @_;
1700	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1807	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1808
		1809	0
1701	}	1810	}
1702		1811
1703	sub _draw {	1812	sub _draw {
1704	my ($self) = @_;	1813	my ($self) = @_;
1705		1814
1706	local $self->{fg} = $self->{fg};	1815	local $self->{fg} = $self->{fg};
1707		1816
1708	if ($FOCUS == $self) {	1817	if ($FOCUS == $self) {
1709	glColor @{$self->{active_bg}};	1818	glColor_premultiply @{$self->{active_bg}};
1710	$self->{fg} = $self->{active_fg};	1819	$self->{fg} = $self->{active_fg};
1711	} else {	1820	} else {
1712	glColor @{$self->{bg}};	1821	glColor_premultiply @{$self->{bg}};
1713	}	1822	}
1714		1823
1715	glEnable GL_BLEND;	1824	glEnable GL_BLEND;
1716	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1825	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1717	glBegin GL_QUADS;	1826	glBegin GL_QUADS;
1718	glVertex 0 , 0;	1827	glVertex 0 , 0;
1719	glVertex 0 , $self->{h};	1828	glVertex 0 , $self->{h};
1720	glVertex $self->{w}, $self->{h};	1829	glVertex $self->{w}, $self->{h};
1721	glVertex $self->{w}, 0;	1830	glVertex $self->{w}, 0;
…		…
1782	} else {	1891	} else {
1783	$self->set_text ($self->{history_saveback});	1892	$self->set_text ($self->{history_saveback});
1784	}	1893	}
1785		1894
1786	} else {	1895	} else {
1787	$self->SUPER::key_down ($ev);	1896	return $self->SUPER::key_down ($ev)
		1897	}
		1898
1788	}	1899	1
1789
1790	}	1900	}
1791		1901
1792	#############################################################################	1902	#############################################################################
1793		1903
1794	package CFClient::UI::Button;	1904	package CFClient::UI::Button;
…		…
1823	my ($self, $ev, $x, $y) = @_;	1933	my ($self, $ev, $x, $y) = @_;
1824		1934
1825	$self->emit ("activate")	1935	$self->emit ("activate")
1826	if $x >= 0 && $x < $self->{w}	1936	if $x >= 0 && $x < $self->{w}
1827	&& $y >= 0 && $y < $self->{h};	1937	&& $y >= 0 && $y < $self->{h};
		1938
		1939	1
1828	}	1940	}
1829		1941
1830	sub _draw {	1942	sub _draw {
1831	my ($self) = @_;	1943	my ($self) = @_;
1832		1944
1833	local $self->{fg} = $self->{fg};	1945	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1834
1835	if ($GRAB == $self) {
1836	$self->{fg} = $self->{active_fg};
1837	}
1838		1946
1839	glEnable GL_TEXTURE_2D;	1947	glEnable GL_TEXTURE_2D;
1840	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1948	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1841	glColor 0, 0, 0, 1;	1949	glColor 0, 0, 0, 1;
1842		1950
…		…
1886		1994
1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	1995	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	1996	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1889	$self->{state} = !$self->{state};	1997	$self->{state} = !$self->{state};
1890	$self->_emit (changed => $self->{state});	1998	$self->_emit (changed => $self->{state});
		1999	} else {
		2000	return 0
		2001	}
		2002
1891	}	2003	1
1892	}	2004	}
1893		2005
1894	sub _draw {	2006	sub _draw {
1895	my ($self) = @_;	2007	my ($self) = @_;
1896		2008
…		…
2063		2175
2064	my $h1 = $self->{h} * (1 - $ycut1);	2176	my $h1 = $self->{h} * (1 - $ycut1);
2065	my $h2 = $self->{h} * (1 - $ycut2);	2177	my $h2 = $self->{h} * (1 - $ycut2);
2066		2178
2067	glEnable GL_BLEND;	2179	glEnable GL_BLEND;
2068	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2180	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2181	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2069	glEnable GL_TEXTURE_2D;	2182	glEnable GL_TEXTURE_2D;
2070	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2183	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2071		2184
2072	glBindTexture GL_TEXTURE_2D, $t1->{name};	2185	glBindTexture GL_TEXTURE_2D, $t1->{name};
2073	glBegin GL_QUADS;	2186	glBegin GL_QUADS;
…		…
2194	sub set_range {	2307	sub set_range {
2195	my ($self, $range) = @_;	2308	my ($self, $range) = @_;
2196		2309
2197	($range, $self->{range}) = ($self->{range}, $range);	2310	($range, $self->{range}) = ($self->{range}, $range);
2198		2311
2199	$self->update
2200	if "@$range" ne "@{$self->{range}}";	2312	if ("@$range" ne "@{$self->{range}}") {
		2313	$self->update;
		2314	$self->set_value ($self->{range}[0]);
		2315	}
2201	}	2316	}
2202		2317
2203	sub set_value {	2318	sub set_value {
2204	my ($self, $value) = @_;	2319	my ($self, $value) = @_;
2205		2320
…		…
2234		2349
2235	$self->SUPER::button_down ($ev, $x, $y);	2350	$self->SUPER::button_down ($ev, $x, $y);
2236		2351
2237	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2352	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2238		2353
2239	$self->mouse_motion ($ev, $x, $y);	2354	$self->mouse_motion ($ev, $x, $y)
2240	}	2355	}
2241		2356
2242	sub mouse_motion {	2357	sub mouse_motion {
2243	my ($self, $ev, $x, $y) = @_;	2358	my ($self, $ev, $x, $y) = @_;
2244		2359
…		…
2248	my (undef, $lo, $hi, $page) = @{$self->{range}};	2363	my (undef, $lo, $hi, $page) = @{$self->{range}};
2249		2364
2250	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2365	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2251		2366
2252	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2367	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2368	} else {
		2369	return 0;
		2370	}
		2371
2253	}	2372	1
2254	}	2373	}
2255		2374
2256	sub update {	2375	sub update {
2257	my ($self) = @_;	2376	my ($self) = @_;
2258		2377
2259	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2378	delete $self->{knob_w};
		2379	$self->SUPER::update;
		2380	}
		2381
		2382	sub _draw {
		2383	my ($self) = @_;
		2384
		2385	unless ($self->{knob_w}) {
2260	$self->set_value ($self->{range}[0]);	2386	$self->set_value ($self->{range}[0]);
2261		2387
2262	my ($value, $lo, $hi, $page) = @{$self->{range}};	2388	my ($value, $lo, $hi, $page) = @{$self->{range}};
2263	my $range = ($hi - $page - $lo) || 1e-100;	2389	my $range = ($hi - $page - $lo) || 1e-100;
2264		2390
…		…
2270	$value = ($value - $lo) / $range;	2396	$value = ($value - $lo) / $range;
2271	$value = $value * $self->{scale} + $self->{offset};	2397	$value = $value * $self->{scale} + $self->{offset};
2272		2398
2273	$self->{knob_x} = $value - $knob_w * 0.5;	2399	$self->{knob_x} = $value - $knob_w * 0.5;
2274	$self->{knob_w} = $knob_w;	2400	$self->{knob_w} = $knob_w;
2275	});	2401	}
2276
2277	$self->SUPER::update;
2278	}
2279
2280	sub _draw {
2281	my ($self) = @_;
2282		2402
2283	$self->SUPER::_draw ();	2403	$self->SUPER::_draw ();
2284		2404
2285	glScale $self->{w}, $self->{h};	2405	glScale $self->{w}, $self->{h};
2286		2406
…		…
2359	my $class = shift;	2479	my $class = shift;
2360		2480
2361	my $self = $class->SUPER::new (	2481	my $self = $class->SUPER::new (
2362	fontsize => 1,	2482	fontsize => 1,
2363	can_events => 0,	2483	can_events => 0,
		2484	indent => 0,
2364	#font => default_font	2485	#font => default_font
2365	@_,	2486	@_,
2366		2487
2367	layout => (new CFClient::Layout 1),	2488	layout => (new CFClient::Layout 1),
2368	par => [],	2489	par => [],
…		…
2391	$self->SUPER::size_allocate ($w, $h);	2512	$self->SUPER::size_allocate ($w, $h);
2392		2513
2393	$self->{layout}->set_font ($self->{font}) if $self->{font};	2514	$self->{layout}->set_font ($self->{font}) if $self->{font};
2394	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2515	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2395	$self->{layout}->set_width ($self->{children}[0]{w});	2516	$self->{layout}->set_width ($self->{children}[0]{w});
		2517	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2396		2518
2397	$self->reflow;	2519	$self->reflow;
2398	}	2520	}
2399		2521
2400	sub text_size {	2522	sub text_size {
…		…
2402		2524
2403	my $layout = $self->{layout};	2525	my $layout = $self->{layout};
2404		2526
2405	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2527	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2406	$layout->set_width ($self->{children}[0]{w} - $indent);	2528	$layout->set_width ($self->{children}[0]{w} - $indent);
		2529	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2407	$layout->set_markup ($text);	2530	$layout->set_markup ($text);
2408		2531
2409	$layout->size	2532	$layout->size
2410	}	2533	}
2411		2534
…		…
2450		2573
2451	return unless $self->{h} > 0;	2574	return unless $self->{h} > 0;
2452		2575
2453	delete $self->{texture};	2576	delete $self->{texture};
2454		2577
2455	$ROOT->on_post_alloc ($self, sub {	2578	$ROOT->on_post_alloc ($self => sub {
2456	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2579	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2457		2580
2458	if (delete $self->{need_reflow}) {	2581	if (delete $self->{need_reflow}) {
2459	my $height = 0;	2582	my $height = 0;
2460		2583
…		…
2463	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2586	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2464		2587
2465	for (@{$self->{par}}) {	2588	for (@{$self->{par}}) {
2466	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2589	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2467	$layout->set_width ($W - $_->[3]);	2590	$layout->set_width ($W - $_->[3]);
		2591	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2468	$layout->set_markup ($_->[4]);	2592	$layout->set_markup ($_->[4]);
2469	my ($w, $h) = $layout->size;	2593	my ($w, $h) = $layout->size;
2470	$_->[0] = $w + $_->[3];	2594	$_->[0] = $w + $_->[3];
2471	$_->[1] = $h;	2595	$_->[1] = $h;
2472	}	2596	}
…		…
2475	}	2599	}
2476		2600
2477	$self->{height} = $height;	2601	$self->{height} = $height;
2478		2602
2479	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2603	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2480		2604
2481	delete $self->{texture};	2605	delete $self->{texture};
2482	}	2606	}
2483		2607
2484	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2608	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2485	glClearColor 0.5, 0.5, 0.5, 0;	2609	glClearColor 0, 0, 0, 0;
2486	glClear GL_COLOR_BUFFER_BIT;	2610	glClear GL_COLOR_BUFFER_BIT;
2487		2611
2488	my $top = int $self->{children}[1]{range}[0];	2612	my $top = int $self->{children}[1]{range}[0];
2489		2613
2490	my $y0 = $top;	2614	my $y0 = $top;
…		…
2504	my $h = $par->[1];	2628	my $h = $par->[1];
2505		2629
2506	if ($y0 < $y + $h && $y < $y1) {	2630	if ($y0 < $y + $h && $y < $y1) {
2507	$layout->set_foreground (@{ $par->[2] });	2631	$layout->set_foreground (@{ $par->[2] });
2508	$layout->set_width ($W - $par->[3]);	2632	$layout->set_width ($W - $par->[3]);
		2633	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2509	$layout->set_markup ($par->[4]);	2634	$layout->set_markup ($par->[4]);
2510		2635
2511	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2636	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2512		2637
2513	glRasterPos $par->[3], $y - $y0;	2638	glRasterPos $par->[3], $y - $y0;
…		…
2525	sub _draw {	2650	sub _draw {
2526	my ($self) = @_;	2651	my ($self) = @_;
2527		2652
2528	glEnable GL_TEXTURE_2D;	2653	glEnable GL_TEXTURE_2D;
2529	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2654	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2530	glColor 1, 1, 1, 1;	2655	glColor 0, 0, 0, 1;
2531	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2656	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2532	glDisable GL_TEXTURE_2D;	2657	glDisable GL_TEXTURE_2D;
2533		2658
2534	$self->{children}[1]->draw;	2659	$self->{children}[1]->draw;
2535		2660
2536	}	2661	}
…		…
2664	or return;	2789	or return;
2665		2790
2666	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2791	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2667		2792
2668	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2793	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2669	if $x + $self->{w} > $::WIDTH;	2794	if $x + $self->{w} > $self->{root}{w};
2670		2795
2671	$self->move_abs ($x, $y);	2796	$self->move_abs ($x, $y);
2672	});	2797	});
2673	}	2798	}
2674		2799
…		…
2763	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2888	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2764		2889
2765	if ($tex) {	2890	if ($tex) {
2766	glEnable GL_TEXTURE_2D;	2891	glEnable GL_TEXTURE_2D;
2767	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2892	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2768	glColor 1, 1, 1, 1;	2893	glColor 0, 0, 0, 1;
2769	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2894	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2770	glDisable GL_TEXTURE_2D;	2895	glDisable GL_TEXTURE_2D;
2771	}	2896	}
2772	}	2897	}
2773		2898
…		…
2780	$self->SUPER::DESTROY;	2905	$self->SUPER::DESTROY;
2781	}	2906	}
2782		2907
2783	#############################################################################	2908	#############################################################################
2784		2909
2785	package CFClient::UI::Inventory;	2910	package CFClient::UI::Buttonbar;
2786		2911
2787	our @ISA = CFClient::UI::ScrolledWindow::;	2912	our @ISA = CFClient::UI::HBox::;
2788		2913
2789	sub new {	2914	# 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		2915
2825	#############################################################################	2916	#############################################################################
2826		2917
2827	package CFClient::UI::Menu;	2918	package CFClient::UI::Menu;
2828		2919
…		…
2840	);	2931	);
2841		2932
2842	$self->add ($self->{vbox} = new CFClient::UI::VBox);	2933	$self->add ($self->{vbox} = new CFClient::UI::VBox);
2843		2934
2844	for my $item (@{ $self->{items} }) {	2935	for my $item (@{ $self->{items} }) {
2845	my ($widget, $cb) = @$item;	2936	my ($widget, $cb, $tooltip) = @$item;
2846		2937
2847	# handle various types of items, only text for now	2938	# handle various types of items, only text for now
2848	if (!ref $widget) {	2939	if (!ref $widget) {
2849	$widget = new CFClient::UI::Label	2940	$widget = new CFClient::UI::Label
2850	can_hover => 1,	2941	can_hover => 1,
2851	can_events => 1,	2942	can_events => 1,
2852	text => $widget;	2943	text => $widget,
		2944	tooltip => $tooltip
2853	}	2945	}
2854		2946
2855	$self->{item}{$widget} = $item;	2947	$self->{item}{$widget} = $item;
2856		2948
2857	$self->{vbox}->add ($widget);	2949	$self->{vbox}->add ($widget);
…		…
2878	my ($self, $ev, $x, $y) = @_;	2970	my ($self, $ev, $x, $y) = @_;
2879		2971
2880	# TODO: should use vbox->find_widget or so	2972	# TODO: should use vbox->find_widget or so
2881	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2973	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2882	$self->{hover} = $self->{item}{$HOVER};	2974	$self->{hover} = $self->{item}{$HOVER};
		2975
		2976	0
2883	}	2977	}
2884		2978
2885	sub button_up {	2979	sub button_up {
2886	my ($self, $ev, $x, $y) = @_;	2980	my ($self, $ev, $x, $y) = @_;
2887		2981
…		…
2889	undef $GRAB;	2983	undef $GRAB;
2890	$self->hide;	2984	$self->hide;
2891		2985
2892	$self->_emit ("popdown");	2986	$self->_emit ("popdown");
2893	$self->{hover}[1]->() if $self->{hover};	2987	$self->{hover}[1]->() if $self->{hover};
		2988	} else {
		2989	return 0
		2990	}
		2991
2894	}	2992	1
2895	}	2993	}
2896		2994
2897	#############################################################################	2995	#############################################################################
2898		2996
2899	package CFClient::UI::Statusbox;	2997	package CFClient::UI::Multiplexer;
2900		2998
2901	our @ISA = CFClient::UI::VBox::;	2999	our @ISA = CFClient::UI::Container::;
2902		3000
2903	sub new {	3001	sub new {
2904	my $class = shift;	3002	my $class = shift;
2905		3003
2906	$class->SUPER::new (	3004	my $self = $class->SUPER::new (
		3005	@_,
		3006	);
		3007
		3008	$self->{current} = $self->{children}[0]
		3009	if @{ $self->{children} };
		3010
		3011	$self
		3012	}
		3013
		3014	sub add {
		3015	my ($self, @widgets) = @_;
		3016
		3017	$self->SUPER::add (@widgets);
		3018
		3019	$self->{current} = $self->{children}[0]
		3020	if @{ $self->{children} };
		3021	}
		3022
		3023	sub set_current_page {
		3024	my ($self, $page_or_widget) = @_;
		3025
		3026	my $widget = ref $page_or_widget
		3027	? $page_or_widget
		3028	: $self->{children}[$page_or_widget];
		3029
		3030	$self->{current} = $widget;
		3031	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3032
		3033	$self->_emit (page_changed => $self->{current});
		3034
		3035	$self->realloc;
		3036	}
		3037
		3038	sub visible_children {
		3039	$_[0]{current}
		3040	}
		3041
		3042	sub size_request {
		3043	my ($self) = @_;
		3044
		3045	$self->{current}->size_request
		3046	}
		3047
		3048	sub size_allocate {
		3049	my ($self, $w, $h) = @_;
		3050
		3051	$self->{current}->configure (0, 0, $w, $h);
		3052	}
		3053
		3054	sub _draw {
		3055	my ($self) = @_;
		3056
		3057	$self->{current}->draw;
		3058	}
		3059
		3060	#############################################################################
		3061
		3062	package CFClient::UI::Notebook;
		3063
		3064	our @ISA = CFClient::UI::VBox::;
		3065
		3066	sub new {
		3067	my $class = shift;
		3068
		3069	my $self = $class->SUPER::new (
		3070	buttonbar => (new CFClient::UI::Buttonbar),
		3071	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3072	# filter => # will be put between multiplexer and $self
		3073	@_,
		3074	);
		3075
		3076	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3077	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3078
		3079	$self
		3080	}
		3081
		3082	sub add {
		3083	my ($self, $title, $widget, $tooltip) = @_;
		3084
		3085	Scalar::Util::weaken $self;
		3086
		3087	$self->{buttonbar}->add (new CFClient::UI::Button
		3088	markup => $title,
		3089	tooltip => $tooltip,
		3090	on_activate => sub { $self->set_current_page ($widget) },
		3091	);
		3092
		3093	$self->{multiplexer}->add ($widget);
		3094	}
		3095
		3096	sub set_current_page {
		3097	my ($self, $page) = @_;
		3098
		3099	$self->{multiplexer}->set_current_page ($page);
		3100	$self->_emit (page_changed => $self->{multiplexer}{current});
		3101	}
		3102
		3103	#############################################################################
		3104
		3105	package CFClient::UI::Combobox;
		3106
		3107	use utf8;
		3108
		3109	our @ISA = CFClient::UI::Button::;
		3110
		3111	sub new {
		3112	my $class = shift;
		3113
		3114	my $self = $class->SUPER::new (
		3115	options => [], # [title, value, tooltip], ...
		3116	value => undef,
		3117	@_,
		3118	);
		3119
		3120	$self->_set_value ($self->{value});
		3121
		3122	$self
		3123	}
		3124
		3125	sub button_down {
		3126	my ($self, $ev) = @_;
		3127
		3128	my @menu_items;
		3129
		3130	for (@{ $self->{options} }) {
		3131	my ($title, $value, $tooltip) = @$_;
		3132
		3133	push @menu_items, [$tooltip, sub { $self->set_value ($value) }];
		3134	}
		3135
		3136	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3137	}
		3138
		3139	sub _set_value {
		3140	my ($self, $value) = @_;
		3141
		3142	my ($item) = grep $_->[1] eq $value, @{ $self->{options} }
		3143	or return;
		3144
		3145	$self->{value} = $item->[1];
		3146	$self->set_markup ("$item->[0] ⇓");
		3147	$self->set_tooltip ($item->[2]);
		3148	}
		3149
		3150	sub set_value {
		3151	my ($self, $value) = @_;
		3152
		3153	return unless $self->{value} ne $value;
		3154
		3155	$self->_set_value ($value);
		3156	$self->_emit (changed => $value);
		3157	}
		3158
		3159	#############################################################################
		3160
		3161	package CFClient::UI::Statusbox;
		3162
		3163	our @ISA = CFClient::UI::VBox::;
		3164
		3165	sub new {
		3166	my $class = shift;
		3167
		3168	my $self = $class->SUPER::new (
2907	fontsize => 0.8,	3169	fontsize => 0.8,
2908	@_,	3170	@_,
2909	)	3171	);
		3172
		3173	Scalar::Util::weaken (my $this = $self);
		3174
		3175	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3176
		3177	$self
2910	}	3178	}
2911		3179
2912	sub reorder {	3180	sub reorder {
2913	my ($self) = @_;	3181	my ($self) = @_;
2914	my $NOW = time;	3182	my $NOW = Time::HiRes::time;
		3183
		3184	# freeze display when hovering over any label
		3185	return if $CFClient::UI::TOOLTIP->{owner}
		3186	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3187	values %{ $self->{item} };
2915		3188
2916	while (my ($k, $v) = each %{ $self->{item} }) {	3189	while (my ($k, $v) = each %{ $self->{item} }) {
2917	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3190	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2918	}	3191	}
2919		3192
…		…
2922	my @items = sort {	3195	my @items = sort {
2923	$a->{pri} <=> $b->{pri}	3196	$a->{pri} <=> $b->{pri}
2924	or $b->{id} <=> $a->{id}	3197	or $b->{id} <=> $a->{id}
2925	} values %{ $self->{item} };	3198	} values %{ $self->{item} };
2926		3199
		3200	$self->{timer}->interval (1);
		3201
2927	my $count = 10 + 1;	3202	my $count = 10 + 1;
2928	for my $item (@items) {	3203	for my $item (@items) {
2929	last unless --$count;	3204	last unless --$count;
2930		3205
2931	push @widgets, $item->{label} ||= do {	3206	my $label = $item->{label} ||= do {
2932	# TODO: doesn't handle markup well (read as: at all)	3207	# TODO: doesn't handle markup well (read as: at all)
2933	my $short = $item->{count} > 1	3208	my $short = $item->{count} > 1
2934	? "<b>$item->{count} ×</b> $item->{text}"	3209	? "<b>$item->{count} ×</b> $item->{text}"
2935	: $item->{text};	3210	: $item->{text};
2936		3211
…		…
2944	tooltip => $item->{tooltip},	3219	tooltip => $item->{tooltip},
2945	tooltip_font => $::FONT_PROP,	3220	tooltip_font => $::FONT_PROP,
2946	tooltip_width => 0.67,	3221	tooltip_width => 0.67,
2947	fontsize => $item->{fontsize} || $self->{fontsize},	3222	fontsize => $item->{fontsize} || $self->{fontsize},
2948	max_w => $::WIDTH * 0.44,	3223	max_w => $::WIDTH * 0.44,
2949	fg => $item->{fg},	3224	fg => [@{ $item->{fg} }],
2950	can_events => 1,	3225	can_events => 1,
2951	can_hover => 1	3226	can_hover => 1
2952	};	3227	};
		3228
		3229	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3230	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3231	$label->update;
		3232	$label->set_max_size (undef, $label->{req_h} * $diff)
		3233	if $diff < 1;
		3234	$self->{timer}->interval (1/30);
		3235	} else {
		3236	$label->{fg}[3] = $item->{fg}[3] || 1;
		3237	}
		3238
		3239	push @widgets, $label;
2953	}	3240	}
2954		3241
2955	$self->clear;	3242	$self->clear;
2956	$self->SUPER::add (reverse @widgets);	3243	$self->SUPER::add (reverse @widgets);
2957	}	3244	}
…		…
2962	$text =~ s/^\s+//;	3249	$text =~ s/^\s+//;
2963	$text =~ s/\s+$//;	3250	$text =~ s/\s+$//;
2964		3251
2965	return unless $text;	3252	return unless $text;
2966		3253
2967	my $timeout = time + ((delete $arg{timeout}) || 60);	3254	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2968		3255
2969	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3256	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2970		3257
2971	if (my $item = $self->{item}{$group}) {	3258	if (my $item = $self->{item}{$group}) {
2972	if ($item->{text} eq $text) {	3259	if ($item->{text} eq $text) {
…		…
3002		3289
3003	$self->reorder;	3290	$self->reorder;
3004	$self->SUPER::reconfigure;	3291	$self->SUPER::reconfigure;
3005	}	3292	}
3006		3293
		3294	sub DESTROY {
		3295	my ($self) = @_;
		3296
		3297	$self->{timer}->cancel;
		3298
		3299	$self->SUPER::DESTROY;
		3300	}
		3301
3007	#############################################################################	3302	#############################################################################
3008		3303
		3304	package CFClient::UI::Inventory;
		3305
		3306	our @ISA = CFClient::UI::ScrolledWindow::;
		3307
		3308	sub new {
		3309	my $class = shift;
		3310
		3311	my $self = $class->SUPER::new (
		3312	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3313	@_,
		3314	);
		3315
		3316	$self
		3317	}
		3318
		3319	sub set_items {
		3320	my ($self, $items) = @_;
		3321
		3322	$self->{child}->clear;
		3323	return unless $items;
		3324
		3325	my @items = sort {
		3326	($a->{type} <=> $b->{type})
		3327	or ($a->{name} cmp $b->{name})
		3328	} @$items;
		3329
		3330	$self->{real_items} = \@items;
		3331
		3332	my $row = 0;
		3333	for my $item (@items) {
		3334	CFClient::Item::update_widgets $item;
		3335
		3336	$self->{child}->add (0, $row, $item->{face_widget});
		3337	$self->{child}->add (1, $row, $item->{desc_widget});
		3338	$self->{child}->add (2, $row, $item->{weight_widget});
		3339
		3340	$row++;
		3341	}
		3342	}
		3343
		3344	#############################################################################
		3345
		3346	package CFClient::UI::BindEditor;
		3347
		3348	our @ISA = CFClient::UI::FancyFrame::;
		3349
		3350	sub new {
		3351	my $class = shift;
		3352
		3353	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3354
		3355	$self->add (my $vb = new CFClient::UI::VBox);
		3356
		3357
		3358	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3359	text => "start recording",
		3360	tooltip => "Start/Stops recording of actions."
		3361	."All subsequent actions after the recording started will be captured."
		3362	."The actions are displayed after the record was stopped."
		3363	."To bind the action you have to click on the 'Bind' button",
		3364	on_activate => sub {
		3365	unless ($self->{recording}) {
		3366	$self->start;
		3367	} else {
		3368	$self->stop;
		3369	}
		3370	});
		3371
		3372	$vb->add (new CFClient::UI::Label text => "Actions:");
		3373	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3374
		3375	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3376	$vb->add (my $hb = new CFClient::UI::HBox);
		3377	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3378	$hb->add (new CFClient::UI::Button
		3379	text => "bind",
		3380	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3381	on_activate => sub {
		3382	$self->ask_for_bind;
		3383	});
		3384
		3385	$vb->add (my $hb = new CFClient::UI::HBox);
		3386	$hb->add (new CFClient::UI::Button
		3387	text => "ok",
		3388	expand => 1,
		3389	tooltip => "This closes the binding editor and saves the binding",
		3390	on_activate => sub {
		3391	$self->hide;
		3392	$self->commit;
		3393	});
		3394
		3395	$hb->add (new CFClient::UI::Button
		3396	text => "cancel",
		3397	expand => 1,
		3398	tooltip => "This closes the binding editor without saving",
		3399	on_activate => sub {
		3400	$self->hide;
		3401	$self->{binding_cancel}->()
		3402	if $self->{binding_cancel};
		3403	});
		3404
		3405	$self->update_binding_widgets;
		3406
		3407	$self
		3408	}
		3409
		3410	sub commit {
		3411	my ($self) = @_;
		3412	my ($mod, $sym, $cmds) = $self->get_binding;
		3413	if ($sym != 0 && @$cmds > 0) {
		3414	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3415	."'. Don't forget 'Save Config'!");
		3416	$self->{binding_change}->($mod, $sym, $cmds)
		3417	if $self->{binding_change};
		3418	} else {
		3419	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3420	$self->{binding_cancel}->()
		3421	if $self->{binding_cancel};
		3422	}
		3423	}
		3424
		3425	sub start {
		3426	my ($self) = @_;
		3427
		3428	$self->{rec_btn}->set_text ("stop recording");
		3429	$self->{recording} = 1;
		3430	$self->clear_command_list;
		3431	$::CONN->start_record if $::CONN;
		3432	}
		3433
		3434	sub stop {
		3435	my ($self) = @_;
		3436
		3437	$self->{rec_btn}->set_text ("start recording");
		3438	$self->{recording} = 0;
		3439
		3440	my $rec;
		3441	$rec = $::CONN->stop_record if $::CONN;
		3442	return unless ref $rec eq 'ARRAY';
		3443	$self->set_command_list ($rec);
		3444	}
		3445
		3446
		3447	sub ask_for_bind_and_commit {
		3448	my ($self) = @_;
		3449	$self->ask_for_bind (1);
		3450	}
		3451
		3452	sub ask_for_bind {
		3453	my ($self, $commit) = @_;
		3454
		3455	CFClient::Binder::open_binding_dialog (sub {
		3456	my ($mod, $sym) = @_;
		3457	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3458	$self->update_binding_widgets;
		3459	$self->commit if $commit;
		3460	});
		3461	}
		3462
		3463	# $mod and $sym are the modifiers and key symbol
		3464	# $cmds is a array ref of strings (the commands)
		3465	# $cb is the callback that is executed on OK
		3466	# $ccb is the callback that is executed on CANCEL and
		3467	# when the binding was unsuccessful on OK
		3468	sub set_binding {
		3469	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3470
		3471	$self->clear_command_list;
		3472	$self->{recording} = 0;
		3473	$self->{rec_btn}->set_text ("start recording");
		3474
		3475	$self->{binding} = [$mod, $sym];
		3476	$self->{commands} = $cmds;
		3477
		3478	$self->{binding_change} = $cb;
		3479	$self->{binding_cancel} = $ccb;
		3480
		3481	$self->update_binding_widgets;
		3482	}
		3483
		3484	# this is a shortcut method that asks for a binding
		3485	# and then just binds it.
		3486	sub do_quick_binding {
		3487	my ($self, $cmds) = @_;
		3488	$self->set_binding (undef, undef, $cmds, sub {
		3489	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3490	});
		3491	$self->ask_for_bind (1);
		3492	}
		3493
		3494	sub update_binding_widgets {
		3495	my ($self) = @_;
		3496	my ($mod, $sym, $cmds) = $self->get_binding;
		3497	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3498	$self->set_command_list ($cmds);
		3499	}
		3500
		3501	sub get_binding {
		3502	my ($self) = @_;
		3503	return (
		3504	$self->{binding}->[0],
		3505	$self->{binding}->[1],
		3506	[ grep { defined $_ } @{$self->{commands}} ]
		3507	);
		3508	}
		3509
		3510	sub clear_command_list {
		3511	my ($self) = @_;
		3512	$self->{cmdbox}->clear ();
		3513	}
		3514
		3515	sub set_command_list {
		3516	my ($self, $cmds) = @_;
		3517
		3518	$self->{cmdbox}->clear ();
		3519	$self->{commands} = $cmds;
		3520
		3521	my $idx = 0;
		3522
		3523	for (@$cmds) {
		3524	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3525
		3526	my $i = $idx;
		3527	$hb->add (new CFClient::UI::Label text => $_);
		3528	$hb->add (new CFClient::UI::Button
		3529	text => "delete",
		3530	tooltip => "Deletes the action from the record",
		3531	on_activate => sub {
		3532	$self->{cmdbox}->remove ($hb);
		3533	$cmds->[$i] = undef;
		3534	});
		3535
		3536
		3537	$idx++
		3538	}
		3539	}
		3540
		3541	#############################################################################
		3542
		3543	package CFClient::UI::SpellList;
		3544
		3545	our @ISA = CFClient::UI::Table::;
		3546
		3547	sub new {
		3548	my $class = shift;
		3549
		3550	my $self = $class->SUPER::new (
		3551	binding => [],
		3552	commands => [],
		3553	@_,
		3554	)
		3555	}
		3556
		3557	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3558	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.");
		3559	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3560	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.");
		3561	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3562	"<b>Damage</b>. The amount of damage the spell deals when it hits.");
		3563
		3564	sub rebuild_spell_list {
		3565	my ($self) = @_;
		3566
		3567	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3568	$self->clear;
		3569
		3570	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name");
		3571	$self->add (2, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3572	$self->add (3, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3573	$self->add (4, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3574
		3575	my $row = 0;
		3576
		3577	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3578	my $spell = $self->{spell}{$_};
		3579
		3580	$row++;
		3581
		3582	$self->add (0, $row, new CFClient::UI::Face
		3583	face => $spell->{face},
		3584	can_hover => 1,
		3585	can_events => 1,
		3586	tooltip => $spell->{message},
		3587	);
		3588
		3589	$self->add (1, $row, new CFClient::UI::Label
		3590	expand => 1,
		3591	text => $spell->{name},
		3592	can_hover => 1,
		3593	can_events => 1,
		3594	tooltip => $spell->{message},
		3595	);
		3596
		3597	$self->add (2, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3598	$self->add (3, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3599	$self->add (4, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3600
		3601	# TODO: should be done via popup
		3602	$self->add (5, $row, new CFClient::UI::Button
		3603	text => "bind",
		3604	tooltip => "bind spell readying (cast command) to key",
		3605	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) },
		3606	);
		3607	}
		3608	});
		3609	}
		3610
		3611	sub add_spell {
		3612	my ($self, $spell) = @_;
		3613
		3614	$self->{spell}->{$spell->{name}} = $spell;
		3615	$self->rebuild_spell_list;
		3616	}
		3617
		3618	sub remove_spell {
		3619	my ($self, $spell) = @_;
		3620
		3621	delete $self->{spell}->{$spell->{name}};
		3622	$self->rebuild_spell_list;
		3623	}
		3624
		3625	#############################################################################
		3626
3009	package CFClient::UI::Root;	3627	package CFClient::UI::Root;
3010		3628
3011	our @ISA = CFClient::UI::Container::;	3629	our @ISA = CFClient::UI::Container::;
		3630
		3631	use List::Util qw(min max);
3012		3632
3013	use CFClient::OpenGL;	3633	use CFClient::OpenGL;
3014		3634
3015	sub new {	3635	sub new {
3016	my $class = shift;	3636	my $class = shift;
…		…
3122	$_->()	3742	$_->()
3123	for values %{delete $self->{refresh_hook}};	3743	for values %{delete $self->{refresh_hook}};
3124	}	3744	}
3125		3745
3126	if ($self->{realloc}) {	3746	if ($self->{realloc}) {
		3747	my %queue;
3127	my @queue;	3748	my @queue;
		3749	my $widget;
3128		3750
		3751	outer:
3129	while () {	3752	while () {
3130	if ($self->{realloc}) {	3753	if (my $realloc = delete $self->{realloc}) {
3131	#TODO use array-of-depth approach	3754	for $widget (values %$realloc) {
		3755	$widget->{visible} or next; # do not resize invisible widgets
3132		3756
3133	use sort 'stable';	3757	$queue{$widget+0}++ and next; # duplicates are common
3134		3758
3135	@queue = sort { $a->{visible} <=> $b->{visible} }	3759	push @{ $queue[$widget->{visible}] }, $widget;
3136	@queue, values %{delete $self->{realloc}};	3760	}
3137	}	3761	}
3138		3762
		3763	while () {
		3764	@queue or last outer;
		3765
3139	my $widget = pop @queue || last;	3766	$widget = pop @{ $queue[-1] || [] }
		3767	and last;
		3768
		3769	pop @queue;
		3770	}
3140		3771
3141	$widget->{visible} or last; # do not resize invisible widgets	3772	delete $queue{$widget+0};
3142		3773
3143	my ($w, $h) = $widget->size_request;	3774	my ($w, $h) = $widget->size_request;
3144		3775
3145	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;	3776	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3146	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;	3777	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3778
		3779	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3780	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3147		3781
3148	$w = $widget->{force_w} if exists $widget->{force_w};	3782	$w = $widget->{force_w} if exists $widget->{force_w};
3149	$h = $widget->{force_h} if exists $widget->{force_h};	3783	$h = $widget->{force_h} if exists $widget->{force_h};
3150		3784
3151	if ($widget->{req_w} != $w || $widget->{req_h} != $h	3785	if ($widget->{req_w} != $w || $widget->{req_h} != $h
…		…
3154	$widget->{req_h} = $h;	3788	$widget->{req_h} = $h;
3155		3789
3156	$self->{size_alloc}{$widget+0} = $widget;	3790	$self->{size_alloc}{$widget+0} = $widget;
3157		3791
3158	if (my $parent = $widget->{parent}) {	3792	if (my $parent = $widget->{parent}) {
3159	$self->{realloc}{$parent+0} = $parent;	3793	$self->{realloc}{$parent+0} = $parent
3160	#unshift @queue, $parent;	3794	unless $queue{$parent+0};
		3795
3161	$parent->{force_size_alloc} = 1;	3796	$parent->{force_size_alloc} = 1;
3162	$self->{size_alloc}{$parent+0} = $parent;	3797	$self->{size_alloc}{$parent+0} = $parent;
3163	}	3798	}
3164	}	3799	}
3165		3800
…		…
3181		3816
3182	$w = int $w + 0.5;	3817	$w = int $w + 0.5;
3183	$h = int $h + 0.5;	3818	$h = int $h + 0.5;
3184		3819
3185	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	3820	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3821	$widget->{old_w} = $widget->{w};
		3822	$widget->{old_h} = $widget->{h};
		3823
3186	$widget->{w} = $w;	3824	$widget->{w} = $w;
3187	$widget->{h} = $h;	3825	$widget->{h} = $h;
3188		3826
3189	$widget->emit (size_allocate => $w, $h);	3827	$widget->emit (size_allocate => $w, $h);
3190	}	3828	}
…		…
3205	glLoadIdentity;	3843	glLoadIdentity;
3206	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3844	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3207	glMatrixMode GL_MODELVIEW;	3845	glMatrixMode GL_MODELVIEW;
3208	glLoadIdentity;	3846	glLoadIdentity;
3209		3847
		3848	{
		3849	package CFClient::UI::Base;
		3850
		3851	($draw_x, $draw_y, $draw_w, $draw_h) =
		3852	(0, 0, $self->{w}, $self->{h});
		3853	}
		3854
3210	$self->_draw;	3855	$self->_draw;
3211	}	3856	}
3212		3857
3213	#############################################################################	3858	#############################################################################
3214		3859

Diff Legend

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