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.304 by elmex, Tue Jun 13 11:01:04 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;
…		…
270		272
271	return unless $self->{visible};	273	return unless $self->{visible};
272		274
273	$_->set_invisible for $self->children;	275	$_->set_invisible for $self->children;
274		276
		277	delete $self->{visible};
275	delete $self->{root};	278	delete $self->{root};
276	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
…		…
575		593
576	sub DESTROY {	594	sub DESTROY {
577	my ($self) = @_;	595	my ($self) = @_;
578		596
579	delete $WIDGET{$self+0};	597	delete $WIDGET{$self+0};
580	#$self->deactivate;	598
		599	eval { $self->destroy };
		600	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
581	}	601	}
582		602
583	#############################################################################	603	#############################################################################
584		604
585	package CFClient::UI::DrawBG;	605	package CFClient::UI::DrawBG;
…		…
610		630
611	if ($color && (@$color < 4 || $color->[3])) {	631	if ($color && (@$color < 4 || $color->[3])) {
612	my ($w, $h) = @$self{qw(w h)};	632	my ($w, $h) = @$self{qw(w h)};
613		633
614	glEnable GL_BLEND;	634	glEnable GL_BLEND;
615	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	635	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
616	glColor @$color;	636	glColor_premultiply @$color;
617		637
618	glBegin GL_QUADS;	638	glBegin GL_QUADS;
619	glVertex 0 , 0;	639	glVertex 0 , 0;
620	glVertex 0 , $h;	640	glVertex 0 , $h;
621	glVertex $w, $h;	641	glVertex $w, $h;
…		…
652	our @ISA = CFClient::UI::Base::;	672	our @ISA = CFClient::UI::Base::;
653		673
654	sub new {	674	sub new {
655	my ($class, %arg) = @_;	675	my ($class, %arg) = @_;
656		676
657	my $children = delete $arg{children} || [];	677	my $children = delete $arg{children};
658		678
659	my $self = $class->SUPER::new (	679	my $self = $class->SUPER::new (
660	children => [],	680	children => [],
661	can_events => 0,	681	can_events => 0,
662	%arg,	682	%arg,
663	);	683	);
		684
664	$self->add ($_) for @$children;	685	$self->add (@$children)
		686	if $children;
665		687
666	$self	688	$self
667	}	689	}
668		690
669	sub add {	691	sub add {
…		…
717	$x -= $self->{x};	739	$x -= $self->{x};
718	$y -= $self->{y};	740	$y -= $self->{y};
719		741
720	my $res;	742	my $res;
721		743
722	for (reverse @{ $self->{children} }) {	744	for (reverse $self->visible_children) {
723	$res = $_->find_widget ($x, $y)	745	$res = $_->find_widget ($x, $y)
724	and return $res;	746	and return $res;
725	}	747	}
726		748
727	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	749	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
748	}	770	}
749		771
750	sub add {	772	sub add {
751	my ($self, $child) = @_;	773	my ($self, $child) = @_;
752		774
753	$self->{children} = [];	775	$self->SUPER::remove ($_) for @{ $self->{children} };
754
755	$self->SUPER::add ($child);	776	$self->SUPER::add ($child);
756	}	777	}
757		778
758	sub remove {	779	sub remove {
759	my ($self, $widget) = @_;	780	my ($self, $widget) = @_;
…		…
776	$self->{children}[0]->configure (0, 0, $w, $h);	797	$self->{children}[0]->configure (0, 0, $w, $h);
777	}	798	}
778		799
779	#############################################################################	800	#############################################################################
780		801
		802	# back-buffered drawing area
		803
781	package CFClient::UI::Window;	804	package CFClient::UI::Window;
782		805
783	our @ISA = CFClient::UI::Bin::;	806	our @ISA = CFClient::UI::Bin::;
784		807
785	use CFClient::OpenGL;	808	use CFClient::OpenGL;
…		…
803	$self->SUPER::size_allocate ($w, $h);	826	$self->SUPER::size_allocate ($w, $h);
804	$self->update;	827	$self->update;
805	}	828	}
806		829
807	sub _render {	830	sub _render {
		831	my ($self) = @_;
		832
808	$_[0]{children}[0]->draw;	833	$self->{children}[0]->draw;
809	}	834	}
810		835
811	sub render_child {	836	sub render_child {
812	my ($self) = @_;	837	my ($self) = @_;
813		838
814	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	839	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
815	glClearColor 0, 0, 0, 0;	840	glClearColor 0, 0, 0, 0;
816	glClear GL_COLOR_BUFFER_BIT;	841	glClear GL_COLOR_BUFFER_BIT;
817		842
		843	{
		844	package CFClient::UI::Base;
		845
		846	($draw_x, $draw_y, $draw_w, $draw_h) =
		847	(0, 0, $self->{w}, $self->{h});
		848	}
		849
818	$self->_render;	850	$self->_render;
819	};	851	};
820	}	852	}
821		853
822	sub _draw {	854	sub _draw {
823	my ($self) = @_;	855	my ($self) = @_;
824		856
825	my ($w, $h) = ($self->w, $self->h);	857	my ($w, $h) = @$self{qw(w h)};
826		858
827	my $tex = $self->{texture}	859	my $tex = $self->{texture}
828	or return;	860	or return;
829		861
830	glEnable GL_TEXTURE_2D;	862	glEnable GL_TEXTURE_2D;
831	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	863	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
832	glColor 1, 1, 1, 1;	864	glColor 0, 0, 0, 1;
833		865
834	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	866	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
835		867
836	glDisable GL_TEXTURE_2D;	868	glDisable GL_TEXTURE_2D;
837	}	869	}
…		…
913	}	945	}
914		946
915	sub _render {	947	sub _render {
916	my ($self) = @_;	948	my ($self) = @_;
917		949
		950	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		951	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		952
918	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	953	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
919		954
920	$self->SUPER::_render;	955	$self->SUPER::_render;
921	}	956	}
922		957
…		…
925	package CFClient::UI::ScrolledWindow;	960	package CFClient::UI::ScrolledWindow;
926		961
927	our @ISA = CFClient::UI::HBox::;	962	our @ISA = CFClient::UI::HBox::;
928		963
929	sub new {	964	sub new {
930	my $class = shift;	965	my ($class, %arg) = @_;
		966
		967	my $child = delete $arg{child};
931		968
932	my $self;	969	my $self;
933		970
934	my $slider = new CFClient::UI::Slider	971	my $slider = new CFClient::UI::Slider
935	vertical => 1,	972	vertical => 1,
…		…
940	;	977	;
941		978
942	$self = $class->SUPER::new (	979	$self = $class->SUPER::new (
943	vp => (new CFClient::UI::ViewPort expand => 1),	980	vp => (new CFClient::UI::ViewPort expand => 1),
944	slider => $slider,	981	slider => $slider,
945	@_,	982	%arg,
946	);	983	);
947		984
948	$self->{vp}->add ($self->{scrolled});
949	$self->add ($self->{vp});
950	$self->add ($self->{slider});	985	$self->SUPER::add ($self->{vp}, $self->{slider});
		986	$self->add ($child) if $child;
951		987
952	$self	988	$self
		989	}
		990
		991	sub add {
		992	my ($self, $widget) = @_;
		993
		994	$self->{vp}->add ($self->{child} = $widget);
953	}	995	}
954		996
955	sub update {	997	sub update {
956	my ($self) = @_;	998	my ($self) = @_;
957		999
…		…
996		1038
997	if ($self->{bg}) {	1039	if ($self->{bg}) {
998	my ($w, $h) = @$self{qw(w h)};	1040	my ($w, $h) = @$self{qw(w h)};
999		1041
1000	glEnable GL_BLEND;	1042	glEnable GL_BLEND;
1001	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1043	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1002	glColor @{ $self->{bg} };	1044	glColor_premultiply @{ $self->{bg} };
1003		1045
1004	glBegin GL_QUADS;	1046	glBegin GL_QUADS;
1005	glVertex 0 , 0;	1047	glVertex 0 , 0;
1006	glVertex 0 , $h;	1048	glVertex 0 , $h;
1007	glVertex $w, $h;	1049	glVertex $w, $h;
…		…
1029	my @border =	1071	my @border =
1030	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1072	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);	1073	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1032		1074
1033	sub new {	1075	sub new {
1034	my $class = shift;	1076	my ($class, %arg) = @_;
1035		1077
1036	my $self = $class->SUPER::new (	1078	my $self = $class->SUPER::new (
1037	bg => [1, 1, 1, 1],	1079	bg => [1, 1, 1, 1],
1038	border_bg => [1, 1, 1, 1],	1080	border_bg => [1, 1, 1, 1],
1039	border => 0.6,	1081	border => 0.6,
1040	can_events => 1,	1082	can_events => 1,
1041	min_w => 16,	1083	min_w => 16,
1042	min_h => 16,	1084	min_h => 16,
1043	@_	1085	%arg,
1044	);	1086	);
1045		1087
1046	$self->{title} &&= new CFClient::UI::Label	1088	$self->{title_widget} = new CFClient::UI::Label
1047	align => 0,	1089	align => 0,
1048	valign => 1,	1090	valign => 1,
1049	text => $self->{title},	1091	text => $self->{title},
1050	fontsize => $self->{border};	1092	fontsize => $self->{border},
		1093	if exists $self->{title};
		1094
		1095	unless ($self->{no_close_button}) {
		1096	$self->{close_btn} =
		1097	new CFClient::UI::ImageButton
		1098	image => 'x1_close.png',
		1099	on_activate => sub { $self->hide };
		1100
		1101	$self->CFClient::UI::Container::add ($self->{close_btn});
		1102	}
1051		1103
1052	$self	1104	$self
		1105	}
		1106
		1107	sub add {
		1108	my ($self, @widgets) = @_;
		1109
		1110	$self->SUPER::add (@widgets);
		1111	$self->CFClient::UI::Container::add ($self->{close_btn}) if $self->{close_btn};
		1112	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1053	}	1113	}
1054		1114
1055	sub border {	1115	sub border {
1056	int $_[0]{border} * $::FONTSIZE	1116	int $_[0]{border} * $::FONTSIZE
1057	}	1117	}
1058		1118
1059	sub size_request {	1119	sub size_request {
1060	my ($self) = @_;	1120	my ($self) = @_;
		1121
		1122	$self->{title_widget}->size_request
		1123	if $self->{title_widget};
		1124
		1125	$self->{close_btn}->size_request
		1126	if $self->{close_btn};
1061		1127
1062	my ($w, $h) = $self->SUPER::size_request;	1128	my ($w, $h) = $self->SUPER::size_request;
1063		1129
1064	(	1130	(
1065	$w + $self->border * 2,	1131	$w + $self->border * 2,
…		…
1068	}	1134	}
1069		1135
1070	sub size_allocate {	1136	sub size_allocate {
1071	my ($self, $w, $h) = @_;	1137	my ($self, $w, $h) = @_;
1072		1138
		1139	if ($self->{title_widget}) {
		1140	$self->{title_widget}{w} = $w;
		1141	$self->{title_widget}{h} = $h;
		1142	$self->{title_widget}->size_allocate ($w, $h);
		1143	}
		1144
		1145	my $border = $self->border;
		1146
1073	$h -= List::Util::max 0, $self->border * 2;	1147	$h -= List::Util::max 0, $border * 2;
1074	$w -= List::Util::max 0, $self->border * 2;	1148	$w -= List::Util::max 0, $border * 2;
1075		1149
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);	1150	$self->child->configure ($border, $border, $w, $h);
		1151
		1152	$self->{close_btn}->configure ($self->{w} - (2 * $border), 0, $border, $border)
		1153	if $self->{close_btn};
1080	}	1154	}
1081		1155
1082	sub button_down {	1156	sub button_down {
1083	my ($self, $ev, $x, $y) = @_;	1157	my ($self, $ev, $x, $y) = @_;
1084		1158
…		…
1103	my $dy = $ev->{y} - $oy;	1177	my $dy = $ev->{y} - $oy;
1104		1178
1105	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1179	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1106	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1180	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1107		1181
		1182	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1108	$self->realloc;	1183	$self->realloc;
1109	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1110	};	1184	};
1111		1185
1112	} elsif ($lr ^ $td) {	1186	} elsif ($lr ^ $td) {
1113	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1187	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1114	my ($bx, $by) = ($self->{x}, $self->{y});	1188	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1117	my ($ev, $x, $y) = @_;	1191	my ($ev, $x, $y) = @_;
1118		1192
1119	($x, $y) = ($ev->{x}, $ev->{y});	1193	($x, $y) = ($ev->{x}, $ev->{y});
1120		1194
1121	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1195	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
		1196	# HACK: the next line is required to enforce placement
		1197	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});
1122	};	1198	};
		1199	} else {
		1200	return 0;
		1201	}
		1202
1123	}	1203	1
1124	}	1204	}
1125		1205
1126	sub button_up {	1206	sub button_up {
1127	my ($self, $ev, $x, $y) = @_;	1207	my ($self, $ev, $x, $y) = @_;
1128		1208
		1209	$self->{close_btn}->button_up ($ev, $x, $y)
		1210	if $self->{close_btn};
		1211
1129	delete $self->{motion};	1212	!!delete $self->{motion}
1130	}	1213	}
1131		1214
1132	sub mouse_motion {	1215	sub mouse_motion {
1133	my ($self, $ev, $x, $y) = @_;	1216	my ($self, $ev, $x, $y) = @_;
1134		1217
1135	$self->{motion}->($ev, $x, $y) if $self->{motion};	1218	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1219
		1220	!!$self->{motion}
1136	}	1221	}
1137		1222
1138	sub _draw {	1223	sub _draw {
1139	my ($self) = @_;	1224	my ($self) = @_;
1140		1225
		1226	my $child = $self->{children}[0];
		1227
1141	my ($w, $h ) = ($self->{w}, $self->{h});	1228	my ($w, $h ) = ($self->{w}, $self->{h});
1142	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1229	my ($cw, $ch) = ($child->{w}, $child->{h});
1143		1230
1144	glEnable GL_TEXTURE_2D;	1231	glEnable GL_TEXTURE_2D;
1145	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1232	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1146		1233
1147	my $border = $self->border;	1234	my $border = $self->border;
…		…
1162	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1249	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1163	}	1250	}
1164		1251
1165	glDisable GL_TEXTURE_2D;	1252	glDisable GL_TEXTURE_2D;
1166		1253
1167	$self->{title}->draw if $self->{title};
1168
1169	$self->child->draw;	1254	$child->draw;
		1255
		1256	if ($self->{title_widget}) {
		1257	glTranslate 0, $border - $self->{h};
		1258	$self->{title_widget}->_draw;
		1259
		1260	glTranslate 0, - ($border - $self->{h});
		1261	}
		1262
		1263	$self->{close_btn}->draw
		1264	if $self->{close_btn};
1170	}	1265	}
1171		1266
1172	#############################################################################	1267	#############################################################################
1173		1268
1174	package CFClient::UI::Table;	1269	package CFClient::UI::Table;
…		…
1197		1292
1198	$child->set_parent ($self);	1293	$child->set_parent ($self);
1199	$self->{children}[$y][$x] = $child;	1294	$self->{children}[$y][$x] = $child;
1200		1295
1201	$self->realloc;	1296	$self->realloc;
		1297	}
		1298
		1299	sub remove {
		1300	my ($self, $child) = @_;
		1301
		1302	# TODO: not yet implemented
1202	}	1303	}
1203		1304
1204	# TODO: move to container class maybe? send children a signal on removal?	1305	# TODO: move to container class maybe? send children a signal on removal?
1205	sub clear {	1306	sub clear {
1206	my ($self) = @_;	1307	my ($self) = @_;
…		…
1467		1568
1468	delete $self->{texture};	1569	delete $self->{texture};
1469	$self->SUPER::update;	1570	$self->SUPER::update;
1470	}	1571	}
1471		1572
		1573	sub realloc {
		1574	my ($self) = @_;
		1575
		1576	delete $self->{ox};
		1577	$self->SUPER::realloc;
		1578	}
		1579
1472	sub set_text {	1580	sub set_text {
1473	my ($self, $text) = @_;	1581	my ($self, $text) = @_;
1474		1582
1475	return if $self->{text} eq "T$text";	1583	return if $self->{text} eq "T$text";
1476	$self->{text} = "T$text";	1584	$self->{text} = "T$text";
1477		1585
1478	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1586	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1479	$self->{layout}->set_text ($text);	1587	$self->{layout}->set_text ($text);
1480		1588
		1589	delete $self->{size_req};
1481	$self->realloc;	1590	$self->realloc;
1482	$self->update;	1591	$self->update;
1483	}	1592	}
1484		1593
1485	sub set_markup {	1594	sub set_markup {
…		…
1491	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1600	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1492		1601
1493	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1602	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1494	$self->{layout}->set_markup ($markup);	1603	$self->{layout}->set_markup ($markup);
1495		1604
		1605	delete $self->{size_req};
1496	$self->realloc;	1606	$self->realloc;
1497	$self->update;	1607	$self->update;
1498	}	1608	}
1499		1609
1500	sub size_request {	1610	sub size_request {
1501	my ($self) = @_;	1611	my ($self) = @_;
1502		1612
		1613	$self->{size_req} ||= do {
1503	$self->{layout}->set_font ($self->{font}) if $self->{font};	1614	$self->{layout}->set_font ($self->{font}) if $self->{font};
1504	$self->{layout}->set_width ($self->{max_w} || -1);	1615	$self->{layout}->set_width ($self->{max_w} || -1);
1505	$self->{layout}->set_ellipsise ($self->{ellipsise});	1616	$self->{layout}->set_ellipsise ($self->{ellipsise});
1506	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1617	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1507	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1618	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1508		1619
1509	my ($w, $h) = $self->{layout}->size;	1620	my ($w, $h) = $self->{layout}->size;
1510		1621
1511	if (exists $self->{template}) {	1622	if (exists $self->{template}) {
1512	$self->{template}->set_font ($self->{font}) if $self->{font};	1623	$self->{template}->set_font ($self->{font}) if $self->{font};
1513	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1624	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1514		1625
1515	my ($w2, $h2) = $self->{template}->size;	1626	my ($w2, $h2) = $self->{template}->size;
1516		1627
1517	$w = List::Util::max $w, $w2;	1628	$w = List::Util::max $w, $w2;
1518	$h = List::Util::max $h, $h2;	1629	$h = List::Util::max $h, $h2;
		1630	}
		1631
		1632	[$w, $h]
1519	}	1633	};
1520		1634
1521	($w, $h)	1635	@{ $self->{size_req} }
1522	}	1636	}
1523		1637
1524	sub size_allocate {	1638	sub size_allocate {
1525	my ($self, $w, $h) = @_;	1639	my ($self, $w, $h) = @_;
1526		1640
		1641	delete $self->{ox};
		1642
1527	delete $self->{texture};	1643	delete $self->{texture}
		1644	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1528	}	1645	}
1529		1646
1530	sub set_fontsize {	1647	sub set_fontsize {
1531	my ($self, $fontsize) = @_;	1648	my ($self, $fontsize) = @_;
1532		1649
1533	$self->{fontsize} = $fontsize;	1650	$self->{fontsize} = $fontsize;
1534	delete $self->{texture};	1651	delete $self->{texture};
1535		1652
1536	$self->realloc;	1653	$self->realloc;
		1654	}
		1655
		1656	sub reconfigure {
		1657	my ($self) = @_;
		1658
		1659	delete $self->{size_req};
		1660
		1661	$self->SUPER::reconfigure;
1537	}	1662	}
1538		1663
1539	sub _draw {	1664	sub _draw {
1540	my ($self) = @_;	1665	my ($self) = @_;
1541		1666
…		…
1547	$self->{layout}->set_width ($self->{w});	1672	$self->{layout}->set_width ($self->{w});
1548	$self->{layout}->set_ellipsise ($self->{ellipsise});	1673	$self->{layout}->set_ellipsise ($self->{ellipsise});
1549	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1674	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1550	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1675	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1551		1676
1552	my $tex = new_from_layout CFClient::Texture $self->{layout};	1677	new_from_layout CFClient::Texture $self->{layout}
		1678	};
1553		1679
		1680	unless (exists $self->{ox}) {
1554	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1681	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1555	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1682	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1556	: ($self->{w} - $tex->{w}) * 0.5);	1683	: ($self->{w} - $tex->{w}) * 0.5);
1557		1684
1558	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1685	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1559	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1686	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1560	: ($self->{h} - $tex->{h}) * 0.5);	1687	: ($self->{h} - $tex->{h}) * 0.5);
1561
1562	$tex
1563	};	1688	};
1564		1689
1565	glEnable GL_TEXTURE_2D;	1690	glEnable GL_TEXTURE_2D;
1566	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1691
		1692	my $w = List::Util::min $self->{w} + 4, $tex->{w};
		1693	my $h = List::Util::min $self->{h} + 2, $tex->{h};
1567		1694
1568	if ($tex->{format} == GL_ALPHA) {	1695	if ($tex->{format} == GL_ALPHA) {
		1696	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1569	glColor @{$self->{fg}};	1697	glColor @{$self->{fg}};
1570	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1698	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1571	} else {	1699	} else {
		1700	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1572	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1701	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1573	}	1702	}
1574		1703
1575	glDisable GL_TEXTURE_2D;	1704	glDisable GL_TEXTURE_2D;
1576	}	1705	}
1577		1706
…		…
1594	can_hover => 1,	1723	can_hover => 1,
1595	can_focus => 1,	1724	can_focus => 1,
1596	valign => 0,	1725	valign => 0,
1597	can_events => 1,	1726	can_events => 1,
1598	#text => ...	1727	#text => ...
		1728	#hidden => "*",
1599	@_	1729	@_
1600	)	1730	)
1601	}	1731	}
1602		1732
1603	sub _set_text {	1733	sub _set_text {
…		…
1605		1735
1606	delete $self->{cur_h};	1736	delete $self->{cur_h};
1607		1737
1608	return if $self->{text} eq $text;	1738	return if $self->{text} eq $text;
1609		1739
1610	delete $self->{texture};
1611
1612	$self->{last_activity} = $::NOW;	1740	$self->{last_activity} = $::NOW;
1613	$self->{text} = $text;	1741	$self->{text} = $text;
1614		1742
1615	$text =~ s/./*/g if $self->{hidden};	1743	$text =~ s/./*/g if $self->{hidden};
1616	$self->{layout}->set_text ("$text ");	1744	$self->{layout}->set_text ("$text ");
		1745	delete $self->{size_req};
1617		1746
1618	$self->_emit (changed => $self->{text});	1747	$self->_emit (changed => $self->{text});
		1748
		1749	$self->realloc;
		1750	$self->update;
1619	}	1751	}
1620		1752
1621	sub set_text {	1753	sub set_text {
1622	my ($self, $text) = @_;	1754	my ($self, $text) = @_;
1623		1755
1624	$self->{cursor} = length $text;	1756	$self->{cursor} = length $text;
1625	$self->_set_text ($text);	1757	$self->_set_text ($text);
1626
1627	$self->realloc;
1628	}	1758	}
1629		1759
1630	sub get_text {	1760	sub get_text {
1631	$_[0]{text}	1761	$_[0]{text}
1632	}	1762	}
…		…
1662	$self->{cursor} = length $text;	1792	$self->{cursor} = length $text;
1663	} elsif ($uni == 27) {	1793	} elsif ($uni == 27) {
1664	$self->_emit ('escape');	1794	$self->_emit ('escape');
1665	} elsif ($uni) {	1795	} elsif ($uni) {
1666	substr $text, $self->{cursor}++, 0, chr $uni;	1796	substr $text, $self->{cursor}++, 0, chr $uni;
		1797	} else {
		1798	return 0;
1667	}	1799	}
1668		1800
1669	$self->_set_text ($text);	1801	$self->_set_text ($text);
1670		1802
1671	$self->realloc;	1803	$self->realloc;
		1804
		1805	1
1672	}	1806	}
1673		1807
1674	sub focus_in {	1808	sub focus_in {
1675	my ($self) = @_;	1809	my ($self) = @_;
1676		1810
…		…
1691	utf8::encode $text;	1825	utf8::encode $text;
1692	$self->{cursor} = length substr $text, 0, $idx;	1826	$self->{cursor} = length substr $text, 0, $idx;
1693		1827
1694	$self->_set_text ($self->{text});	1828	$self->_set_text ($self->{text});
1695	$self->update;	1829	$self->update;
		1830
		1831	1
1696	}	1832	}
1697		1833
1698	sub mouse_motion {	1834	sub mouse_motion {
1699	my ($self, $ev, $x, $y) = @_;	1835	my ($self, $ev, $x, $y) = @_;
1700	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1836	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1837
		1838	0
1701	}	1839	}
1702		1840
1703	sub _draw {	1841	sub _draw {
1704	my ($self) = @_;	1842	my ($self) = @_;
1705		1843
1706	local $self->{fg} = $self->{fg};	1844	local $self->{fg} = $self->{fg};
1707		1845
1708	if ($FOCUS == $self) {	1846	if ($FOCUS == $self) {
1709	glColor @{$self->{active_bg}};	1847	glColor_premultiply @{$self->{active_bg}};
1710	$self->{fg} = $self->{active_fg};	1848	$self->{fg} = $self->{active_fg};
1711	} else {	1849	} else {
1712	glColor @{$self->{bg}};	1850	glColor_premultiply @{$self->{bg}};
1713	}	1851	}
1714		1852
1715	glEnable GL_BLEND;	1853	glEnable GL_BLEND;
1716	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1854	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1717	glBegin GL_QUADS;	1855	glBegin GL_QUADS;
1718	glVertex 0 , 0;	1856	glVertex 0 , 0;
1719	glVertex 0 , $self->{h};	1857	glVertex 0 , $self->{h};
1720	glVertex $self->{w}, $self->{h};	1858	glVertex $self->{w}, $self->{h};
1721	glVertex $self->{w}, 0;	1859	glVertex $self->{w}, 0;
…		…
1782	} else {	1920	} else {
1783	$self->set_text ($self->{history_saveback});	1921	$self->set_text ($self->{history_saveback});
1784	}	1922	}
1785		1923
1786	} else {	1924	} else {
1787	$self->SUPER::key_down ($ev);	1925	return $self->SUPER::key_down ($ev)
		1926	}
		1927
1788	}	1928	1
1789
1790	}	1929	}
1791		1930
1792	#############################################################################	1931	#############################################################################
1793		1932
1794	package CFClient::UI::Button;	1933	package CFClient::UI::Button;
…		…
1823	my ($self, $ev, $x, $y) = @_;	1962	my ($self, $ev, $x, $y) = @_;
1824		1963
1825	$self->emit ("activate")	1964	$self->emit ("activate")
1826	if $x >= 0 && $x < $self->{w}	1965	if $x >= 0 && $x < $self->{w}
1827	&& $y >= 0 && $y < $self->{h};	1966	&& $y >= 0 && $y < $self->{h};
		1967
		1968	1
1828	}	1969	}
1829		1970
1830	sub _draw {	1971	sub _draw {
1831	my ($self) = @_;	1972	my ($self) = @_;
1832		1973
1833	local $self->{fg} = $self->{fg};	1974	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1834
1835	if ($GRAB == $self) {
1836	$self->{fg} = $self->{active_fg};
1837	}
1838		1975
1839	glEnable GL_TEXTURE_2D;	1976	glEnable GL_TEXTURE_2D;
1840	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1977	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1841	glColor 0, 0, 0, 1;	1978	glColor 0, 0, 0, 1;
1842		1979
1843	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	1980	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1844		1981
1845	glDisable GL_TEXTURE_2D;	1982	glDisable GL_TEXTURE_2D;
1846		1983
1847	$self->SUPER::_draw;	1984	$self->SUPER::_draw;
		1985	}
		1986
		1987	#############################################################################
		1988
		1989	package CFClient::UI::ImageButton;
		1990
		1991	our @ISA = CFClient::UI::Image::;
		1992
		1993	use CFClient::OpenGL;
		1994
		1995	my %textures;
		1996
		1997	sub new {
		1998	my $class = shift;
		1999
		2000	my $self = $class->SUPER::new (
		2001	padding_x => 4,
		2002	padding_y => 4,
		2003	fg => [1, 1, 1],
		2004	active_fg => [0, 0, 1],
		2005	can_hover => 1,
		2006	align => 0,
		2007	valign => 0,
		2008	can_events => 1,
		2009	@_
		2010	);
		2011	}
		2012
		2013	sub activate { }
		2014
		2015	sub button_up {
		2016	my ($self, $ev, $x, $y) = @_;
		2017
		2018	$self->emit ("activate")
		2019	if $x >= 0 && $x < $self->{w}
		2020	&& $y >= 0 && $y < $self->{h};
		2021
		2022	1
1848	}	2023	}
1849		2024
1850	#############################################################################	2025	#############################################################################
1851		2026
1852	package CFClient::UI::CheckBox;	2027	package CFClient::UI::CheckBox;
…		…
1886		2061
1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2062	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2063	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1889	$self->{state} = !$self->{state};	2064	$self->{state} = !$self->{state};
1890	$self->_emit (changed => $self->{state});	2065	$self->_emit (changed => $self->{state});
		2066	} else {
		2067	return 0
		2068	}
		2069
1891	}	2070	1
1892	}	2071	}
1893		2072
1894	sub _draw {	2073	sub _draw {
1895	my ($self) = @_;	2074	my ($self) = @_;
1896		2075
…		…
2063		2242
2064	my $h1 = $self->{h} * (1 - $ycut1);	2243	my $h1 = $self->{h} * (1 - $ycut1);
2065	my $h2 = $self->{h} * (1 - $ycut2);	2244	my $h2 = $self->{h} * (1 - $ycut2);
2066		2245
2067	glEnable GL_BLEND;	2246	glEnable GL_BLEND;
2068	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2247	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2248	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2069	glEnable GL_TEXTURE_2D;	2249	glEnable GL_TEXTURE_2D;
2070	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2250	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2071		2251
2072	glBindTexture GL_TEXTURE_2D, $t1->{name};	2252	glBindTexture GL_TEXTURE_2D, $t1->{name};
2073	glBegin GL_QUADS;	2253	glBegin GL_QUADS;
…		…
2194	sub set_range {	2374	sub set_range {
2195	my ($self, $range) = @_;	2375	my ($self, $range) = @_;
2196		2376
2197	($range, $self->{range}) = ($self->{range}, $range);	2377	($range, $self->{range}) = ($self->{range}, $range);
2198		2378
2199	$self->update
2200	if "@$range" ne "@{$self->{range}}";	2379	if ("@$range" ne "@{$self->{range}}") {
		2380	$self->update;
		2381	$self->set_value ($self->{range}[0]);
		2382	}
2201	}	2383	}
2202		2384
2203	sub set_value {	2385	sub set_value {
2204	my ($self, $value) = @_;	2386	my ($self, $value) = @_;
2205		2387
…		…
2234		2416
2235	$self->SUPER::button_down ($ev, $x, $y);	2417	$self->SUPER::button_down ($ev, $x, $y);
2236		2418
2237	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2419	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2238		2420
2239	$self->mouse_motion ($ev, $x, $y);	2421	$self->mouse_motion ($ev, $x, $y)
2240	}	2422	}
2241		2423
2242	sub mouse_motion {	2424	sub mouse_motion {
2243	my ($self, $ev, $x, $y) = @_;	2425	my ($self, $ev, $x, $y) = @_;
2244		2426
…		…
2248	my (undef, $lo, $hi, $page) = @{$self->{range}};	2430	my (undef, $lo, $hi, $page) = @{$self->{range}};
2249		2431
2250	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2432	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2251		2433
2252	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2434	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2435	} else {
		2436	return 0;
		2437	}
		2438
2253	}	2439	1
2254	}	2440	}
2255		2441
2256	sub update {	2442	sub update {
2257	my ($self) = @_;	2443	my ($self) = @_;
2258		2444
2259	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2445	delete $self->{knob_w};
		2446	$self->SUPER::update;
		2447	}
		2448
		2449	sub _draw {
		2450	my ($self) = @_;
		2451
		2452	unless ($self->{knob_w}) {
2260	$self->set_value ($self->{range}[0]);	2453	$self->set_value ($self->{range}[0]);
2261		2454
2262	my ($value, $lo, $hi, $page) = @{$self->{range}};	2455	my ($value, $lo, $hi, $page) = @{$self->{range}};
2263	my $range = ($hi - $page - $lo) || 1e-100;	2456	my $range = ($hi - $page - $lo) || 1e-100;
2264		2457
…		…
2270	$value = ($value - $lo) / $range;	2463	$value = ($value - $lo) / $range;
2271	$value = $value * $self->{scale} + $self->{offset};	2464	$value = $value * $self->{scale} + $self->{offset};
2272		2465
2273	$self->{knob_x} = $value - $knob_w * 0.5;	2466	$self->{knob_x} = $value - $knob_w * 0.5;
2274	$self->{knob_w} = $knob_w;	2467	$self->{knob_w} = $knob_w;
2275	});	2468	}
2276
2277	$self->SUPER::update;
2278	}
2279
2280	sub _draw {
2281	my ($self) = @_;
2282		2469
2283	$self->SUPER::_draw ();	2470	$self->SUPER::_draw ();
2284		2471
2285	glScale $self->{w}, $self->{h};	2472	glScale $self->{w}, $self->{h};
2286		2473
…		…
2347	sub set_range { shift->{slider}->set_range (@_) }	2534	sub set_range { shift->{slider}->set_range (@_) }
2348	sub set_value { shift->{slider}->set_value (@_) }	2535	sub set_value { shift->{slider}->set_value (@_) }
2349		2536
2350	#############################################################################	2537	#############################################################################
2351		2538
2352	package CFClient::UI::TextView;	2539	package CFClient::UI::TextScroller;
2353		2540
2354	our @ISA = CFClient::UI::HBox::;	2541	our @ISA = CFClient::UI::HBox::;
2355		2542
2356	use CFClient::OpenGL;	2543	use CFClient::OpenGL;
2357		2544
…		…
2359	my $class = shift;	2546	my $class = shift;
2360		2547
2361	my $self = $class->SUPER::new (	2548	my $self = $class->SUPER::new (
2362	fontsize => 1,	2549	fontsize => 1,
2363	can_events => 0,	2550	can_events => 0,
		2551	indent => 0,
2364	#font => default_font	2552	#font => default_font
2365	@_,	2553	@_,
2366		2554
2367	layout => (new CFClient::Layout 1),	2555	layout => (new CFClient::Layout 1),
2368	par => [],	2556	par => [],
…		…
2391	$self->SUPER::size_allocate ($w, $h);	2579	$self->SUPER::size_allocate ($w, $h);
2392		2580
2393	$self->{layout}->set_font ($self->{font}) if $self->{font};	2581	$self->{layout}->set_font ($self->{font}) if $self->{font};
2394	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2582	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2395	$self->{layout}->set_width ($self->{children}[0]{w});	2583	$self->{layout}->set_width ($self->{children}[0]{w});
		2584	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2396		2585
2397	$self->reflow;	2586	$self->reflow;
2398	}	2587	}
2399		2588
2400	sub text_size {	2589	sub text_size {
…		…
2402		2591
2403	my $layout = $self->{layout};	2592	my $layout = $self->{layout};
2404		2593
2405	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2594	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2406	$layout->set_width ($self->{children}[0]{w} - $indent);	2595	$layout->set_width ($self->{children}[0]{w} - $indent);
		2596	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2407	$layout->set_markup ($text);	2597	$layout->set_markup ($text);
2408		2598
2409	$layout->size	2599	$layout->size
2410	}	2600	}
2411		2601
…		…
2450		2640
2451	return unless $self->{h} > 0;	2641	return unless $self->{h} > 0;
2452		2642
2453	delete $self->{texture};	2643	delete $self->{texture};
2454		2644
2455	$ROOT->on_post_alloc ($self, sub {	2645	$ROOT->on_post_alloc ($self => sub {
2456	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2646	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2457		2647
2458	if (delete $self->{need_reflow}) {	2648	if (delete $self->{need_reflow}) {
2459	my $height = 0;	2649	my $height = 0;
2460		2650
…		…
2463	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2653	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2464		2654
2465	for (@{$self->{par}}) {	2655	for (@{$self->{par}}) {
2466	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2656	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2467	$layout->set_width ($W - $_->[3]);	2657	$layout->set_width ($W - $_->[3]);
		2658	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2468	$layout->set_markup ($_->[4]);	2659	$layout->set_markup ($_->[4]);
2469	my ($w, $h) = $layout->size;	2660	my ($w, $h) = $layout->size;
2470	$_->[0] = $w + $_->[3];	2661	$_->[0] = $w + $_->[3];
2471	$_->[1] = $h;	2662	$_->[1] = $h;
2472	}	2663	}
…		…
2475	}	2666	}
2476		2667
2477	$self->{height} = $height;	2668	$self->{height} = $height;
2478		2669
2479	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2670	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2480		2671
2481	delete $self->{texture};	2672	delete $self->{texture};
2482	}	2673	}
2483		2674
2484	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2675	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2485	glClearColor 0.5, 0.5, 0.5, 0;	2676	glClearColor 0, 0, 0, 0;
2486	glClear GL_COLOR_BUFFER_BIT;	2677	glClear GL_COLOR_BUFFER_BIT;
2487		2678
2488	my $top = int $self->{children}[1]{range}[0];	2679	my $top = int $self->{children}[1]{range}[0];
2489		2680
2490	my $y0 = $top;	2681	my $y0 = $top;
…		…
2504	my $h = $par->[1];	2695	my $h = $par->[1];
2505		2696
2506	if ($y0 < $y + $h && $y < $y1) {	2697	if ($y0 < $y + $h && $y < $y1) {
2507	$layout->set_foreground (@{ $par->[2] });	2698	$layout->set_foreground (@{ $par->[2] });
2508	$layout->set_width ($W - $par->[3]);	2699	$layout->set_width ($W - $par->[3]);
		2700	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2509	$layout->set_markup ($par->[4]);	2701	$layout->set_markup ($par->[4]);
2510		2702
2511	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2703	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2512		2704
2513	glRasterPos $par->[3], $y - $y0;	2705	glRasterPos $par->[3], $y - $y0;
…		…
2525	sub _draw {	2717	sub _draw {
2526	my ($self) = @_;	2718	my ($self) = @_;
2527		2719
2528	glEnable GL_TEXTURE_2D;	2720	glEnable GL_TEXTURE_2D;
2529	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2721	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2530	glColor 1, 1, 1, 1;	2722	glColor 0, 0, 0, 1;
2531	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2723	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2532	glDisable GL_TEXTURE_2D;	2724	glDisable GL_TEXTURE_2D;
2533		2725
2534	$self->{children}[1]->draw;	2726	$self->{children}[1]->draw;
2535		2727
2536	}	2728	}
…		…
2627	$tooltip .= "\n\n" . (ref $widget) . "\n"	2819	$tooltip .= "\n\n" . (ref $widget) . "\n"
2628	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	2820	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2629	. "req $widget->{req_w} $widget->{req_h}\n"	2821	. "req $widget->{req_w} $widget->{req_h}\n"
2630	. "visible $widget->{visible}";	2822	. "visible $widget->{visible}";
2631	}	2823	}
		2824
		2825	$tooltip =~ s/^\n+//;
		2826	$tooltip =~ s/\n+$//;
2632		2827
2633	$self->add (new CFClient::UI::Label	2828	$self->add (new CFClient::UI::Label
2634	markup => $tooltip,	2829	markup => $tooltip,
2635	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2830	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2636	fontsize => 0.8,	2831	fontsize => 0.8,
…		…
2664	or return;	2859	or return;
2665		2860
2666	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2861	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2667		2862
2668	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2863	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2669	if $x + $self->{w} > $::WIDTH;	2864	if $x + $self->{w} > $self->{root}{w};
2670		2865
2671	$self->move_abs ($x, $y);	2866	$self->move_abs ($x, $y);
2672	});	2867	});
2673	}	2868	}
2674		2869
…		…
2763	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2958	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2764		2959
2765	if ($tex) {	2960	if ($tex) {
2766	glEnable GL_TEXTURE_2D;	2961	glEnable GL_TEXTURE_2D;
2767	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2962	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2768	glColor 1, 1, 1, 1;	2963	glColor 0, 0, 0, 1;
2769	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2964	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2770	glDisable GL_TEXTURE_2D;	2965	glDisable GL_TEXTURE_2D;
2771	}	2966	}
2772	}	2967	}
2773		2968
2774	sub DESTROY {	2969	sub destroy {
2775	my ($self) = @_;	2970	my ($self) = @_;
2776		2971
2777	$self->{timer}->cancel	2972	$self->{timer}->cancel
2778	if $self->{timer};	2973	if $self->{timer};
2779		2974
2780	$self->SUPER::DESTROY;	2975	$self->SUPER::destroy;
2781	}	2976	}
2782		2977
2783	#############################################################################	2978	#############################################################################
2784		2979
2785	package CFClient::UI::Inventory;	2980	package CFClient::UI::Buttonbar;
2786		2981
2787	our @ISA = CFClient::UI::ScrolledWindow::;	2982	our @ISA = CFClient::UI::HBox::;
2788		2983
2789	sub new {	2984	# 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		2985
2825	#############################################################################	2986	#############################################################################
2826		2987
2827	package CFClient::UI::Menu;	2988	package CFClient::UI::Menu;
2828		2989
…		…
2840	);	3001	);
2841		3002
2842	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3003	$self->add ($self->{vbox} = new CFClient::UI::VBox);
2843		3004
2844	for my $item (@{ $self->{items} }) {	3005	for my $item (@{ $self->{items} }) {
2845	my ($widget, $cb) = @$item;	3006	my ($widget, $cb, $tooltip) = @$item;
2846		3007
2847	# handle various types of items, only text for now	3008	# handle various types of items, only text for now
2848	if (!ref $widget) {	3009	if (!ref $widget) {
2849	$widget = new CFClient::UI::Label	3010	$widget = new CFClient::UI::Label
2850	can_hover => 1,	3011	can_hover => 1,
2851	can_events => 1,	3012	can_events => 1,
2852	text => $widget;	3013	markup => $widget,
		3014	tooltip => $tooltip
2853	}	3015	}
2854		3016
2855	$self->{item}{$widget} = $item;	3017	$self->{item}{$widget} = $item;
2856		3018
2857	$self->{vbox}->add ($widget);	3019	$self->{vbox}->add ($widget);
…		…
2878	my ($self, $ev, $x, $y) = @_;	3040	my ($self, $ev, $x, $y) = @_;
2879		3041
2880	# TODO: should use vbox->find_widget or so	3042	# TODO: should use vbox->find_widget or so
2881	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3043	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2882	$self->{hover} = $self->{item}{$HOVER};	3044	$self->{hover} = $self->{item}{$HOVER};
		3045
		3046	0
2883	}	3047	}
2884		3048
2885	sub button_up {	3049	sub button_up {
2886	my ($self, $ev, $x, $y) = @_;	3050	my ($self, $ev, $x, $y) = @_;
2887		3051
…		…
2889	undef $GRAB;	3053	undef $GRAB;
2890	$self->hide;	3054	$self->hide;
2891		3055
2892	$self->_emit ("popdown");	3056	$self->_emit ("popdown");
2893	$self->{hover}[1]->() if $self->{hover};	3057	$self->{hover}[1]->() if $self->{hover};
		3058	} else {
		3059	return 0
		3060	}
		3061
2894	}	3062	1
2895	}	3063	}
2896		3064
2897	#############################################################################	3065	#############################################################################
2898		3066
2899	package CFClient::UI::Statusbox;	3067	package CFClient::UI::Multiplexer;
2900		3068
2901	our @ISA = CFClient::UI::VBox::;	3069	our @ISA = CFClient::UI::Container::;
2902		3070
2903	sub new {	3071	sub new {
2904	my $class = shift;	3072	my $class = shift;
2905		3073
2906	$class->SUPER::new (	3074	my $self = $class->SUPER::new (
		3075	@_,
		3076	);
		3077
		3078	$self->{current} = $self->{children}[0]
		3079	if @{ $self->{children} };
		3080
		3081	$self
		3082	}
		3083
		3084	sub add {
		3085	my ($self, @widgets) = @_;
		3086
		3087	$self->SUPER::add (@widgets);
		3088
		3089	$self->{current} = $self->{children}[0]
		3090	if @{ $self->{children} };
		3091	}
		3092
		3093	sub set_current_page {
		3094	my ($self, $page_or_widget) = @_;
		3095
		3096	my $widget = ref $page_or_widget
		3097	? $page_or_widget
		3098	: $self->{children}[$page_or_widget];
		3099
		3100	$self->{current} = $widget;
		3101	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3102
		3103	$self->_emit (page_changed => $self->{current});
		3104
		3105	$self->realloc;
		3106	}
		3107
		3108	sub visible_children {
		3109	$_[0]{current}
		3110	}
		3111
		3112	sub size_request {
		3113	my ($self) = @_;
		3114
		3115	$self->{current}->size_request
		3116	}
		3117
		3118	sub size_allocate {
		3119	my ($self, $w, $h) = @_;
		3120
		3121	$self->{current}->configure (0, 0, $w, $h);
		3122	}
		3123
		3124	sub _draw {
		3125	my ($self) = @_;
		3126
		3127	$self->{current}->draw;
		3128	}
		3129
		3130	#############################################################################
		3131
		3132	package CFClient::UI::Notebook;
		3133
		3134	our @ISA = CFClient::UI::VBox::;
		3135
		3136	sub new {
		3137	my $class = shift;
		3138
		3139	my $self = $class->SUPER::new (
		3140	buttonbar => (new CFClient::UI::Buttonbar),
		3141	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3142	# filter => # will be put between multiplexer and $self
		3143	@_,
		3144	);
		3145
		3146	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3147	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3148
		3149	$self
		3150	}
		3151
		3152	sub add {
		3153	my ($self, $title, $widget, $tooltip) = @_;
		3154
		3155	Scalar::Util::weaken $self;
		3156
		3157	$self->{buttonbar}->add (new CFClient::UI::Button
		3158	markup => $title,
		3159	tooltip => $tooltip,
		3160	on_activate => sub { $self->set_current_page ($widget) },
		3161	);
		3162
		3163	$self->{multiplexer}->add ($widget);
		3164	}
		3165
		3166	sub set_current_page {
		3167	my ($self, $page) = @_;
		3168
		3169	$self->{multiplexer}->set_current_page ($page);
		3170	$self->_emit (page_changed => $self->{multiplexer}{current});
		3171	}
		3172
		3173	#############################################################################
		3174
		3175	package CFClient::UI::Combobox;
		3176
		3177	use utf8;
		3178
		3179	our @ISA = CFClient::UI::Button::;
		3180
		3181	sub new {
		3182	my $class = shift;
		3183
		3184	my $self = $class->SUPER::new (
		3185	options => [], # [value, title, longdesc], ...
		3186	value => undef,
		3187	@_,
		3188	);
		3189
		3190	$self->_set_value ($self->{value});
		3191
		3192	$self
		3193	}
		3194
		3195	sub button_down {
		3196	my ($self, $ev) = @_;
		3197
		3198	my @menu_items;
		3199
		3200	for (@{ $self->{options} }) {
		3201	my ($value, $title, $tooltip) = @$_;
		3202
		3203	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3204	}
		3205
		3206	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3207	}
		3208
		3209	sub _set_value {
		3210	my ($self, $value) = @_;
		3211
		3212	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3213	or return;
		3214
		3215	$self->{value} = $item->[0];
		3216	$self->set_markup ("$item->[1] ⇓");
		3217	$self->set_tooltip ($item->[2]);
		3218	}
		3219
		3220	sub set_value {
		3221	my ($self, $value) = @_;
		3222
		3223	return unless $self->{value} ne $value;
		3224
		3225	$self->_set_value ($value);
		3226	$self->_emit (changed => $value);
		3227	}
		3228
		3229	#############################################################################
		3230
		3231	package CFClient::UI::Statusbox;
		3232
		3233	our @ISA = CFClient::UI::VBox::;
		3234
		3235	sub new {
		3236	my $class = shift;
		3237
		3238	my $self = $class->SUPER::new (
2907	fontsize => 0.8,	3239	fontsize => 0.8,
2908	@_,	3240	@_,
2909	)	3241	);
		3242
		3243	Scalar::Util::weaken (my $this = $self);
		3244
		3245	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3246
		3247	$self
2910	}	3248	}
2911		3249
2912	sub reorder {	3250	sub reorder {
2913	my ($self) = @_;	3251	my ($self) = @_;
2914	my $NOW = time;	3252	my $NOW = Time::HiRes::time;
		3253
		3254	# freeze display when hovering over any label
		3255	return if $CFClient::UI::TOOLTIP->{owner}
		3256	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3257	values %{ $self->{item} };
2915		3258
2916	while (my ($k, $v) = each %{ $self->{item} }) {	3259	while (my ($k, $v) = each %{ $self->{item} }) {
2917	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3260	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2918	}	3261	}
2919		3262
…		…
2922	my @items = sort {	3265	my @items = sort {
2923	$a->{pri} <=> $b->{pri}	3266	$a->{pri} <=> $b->{pri}
2924	or $b->{id} <=> $a->{id}	3267	or $b->{id} <=> $a->{id}
2925	} values %{ $self->{item} };	3268	} values %{ $self->{item} };
2926		3269
		3270	$self->{timer}->interval (1);
		3271
2927	my $count = 10 + 1;	3272	my $count = 10 + 1;
2928	for my $item (@items) {	3273	for my $item (@items) {
2929	last unless --$count;	3274	last unless --$count;
2930		3275
2931	push @widgets, $item->{label} ||= do {	3276	my $label = $item->{label} ||= do {
2932	# TODO: doesn't handle markup well (read as: at all)	3277	# TODO: doesn't handle markup well (read as: at all)
2933	my $short = $item->{count} > 1	3278	my $short = $item->{count} > 1
2934	? "<b>$item->{count} ×</b> $item->{text}"	3279	? "<b>$item->{count} ×</b> $item->{text}"
2935	: $item->{text};	3280	: $item->{text};
2936		3281
…		…
2944	tooltip => $item->{tooltip},	3289	tooltip => $item->{tooltip},
2945	tooltip_font => $::FONT_PROP,	3290	tooltip_font => $::FONT_PROP,
2946	tooltip_width => 0.67,	3291	tooltip_width => 0.67,
2947	fontsize => $item->{fontsize} || $self->{fontsize},	3292	fontsize => $item->{fontsize} || $self->{fontsize},
2948	max_w => $::WIDTH * 0.44,	3293	max_w => $::WIDTH * 0.44,
2949	fg => $item->{fg},	3294	fg => [@{ $item->{fg} }],
2950	can_events => 1,	3295	can_events => 1,
2951	can_hover => 1	3296	can_hover => 1
2952	};	3297	};
		3298
		3299	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3300	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3301	$label->update;
		3302	$label->set_max_size (undef, $label->{req_h} * $diff)
		3303	if $diff < 1;
		3304	$self->{timer}->interval (1/30);
		3305	} else {
		3306	$label->{fg}[3] = $item->{fg}[3] || 1;
		3307	}
		3308
		3309	push @widgets, $label;
2953	}	3310	}
2954		3311
2955	$self->clear;	3312	$self->clear;
2956	$self->SUPER::add (reverse @widgets);	3313	$self->SUPER::add (reverse @widgets);
2957	}	3314	}
…		…
2962	$text =~ s/^\s+//;	3319	$text =~ s/^\s+//;
2963	$text =~ s/\s+$//;	3320	$text =~ s/\s+$//;
2964		3321
2965	return unless $text;	3322	return unless $text;
2966		3323
2967	my $timeout = time + ((delete $arg{timeout}) || 60);	3324	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2968		3325
2969	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3326	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2970		3327
2971	if (my $item = $self->{item}{$group}) {	3328	if (my $item = $self->{item}{$group}) {
2972	if ($item->{text} eq $text) {	3329	if ($item->{text} eq $text) {
2973	$item->{count}++;	3330	$item->{count}++;
2974	} else {	3331	} else {
2975	$item->{count} = 1;	3332	$item->{count} = 1;
2976	$item->{text} = $item->{tooltip} = $text;	3333	$item->{text} = $item->{tooltip} = $text;
2977	}	3334	}
2978	$item->{id} = ++$self->{id};	3335	$item->{id} += 0.2;#d#
2979	$item->{timeout} = $timeout;	3336	$item->{timeout} = $timeout;
2980	delete $item->{label};	3337	delete $item->{label};
2981	} else {	3338	} else {
2982	$self->{item}{$group} = {	3339	$self->{item}{$group} = {
2983	id => ++$self->{id},	3340	id => ++$self->{id},
…		…
3002		3359
3003	$self->reorder;	3360	$self->reorder;
3004	$self->SUPER::reconfigure;	3361	$self->SUPER::reconfigure;
3005	}	3362	}
3006		3363
		3364	sub destroy {
		3365	my ($self) = @_;
		3366
		3367	$self->{timer}->cancel;
		3368
		3369	$self->SUPER::destroy;
		3370	}
		3371
3007	#############################################################################	3372	#############################################################################
3008		3373
3009	package CFClient::UI::Root;	3374	package CFClient::UI::Inventory;
3010		3375
3011	our @ISA = CFClient::UI::Container::;	3376	our @ISA = CFClient::UI::ScrolledWindow::;
3012
3013	use CFClient::OpenGL;
3014		3377
3015	sub new {	3378	sub new {
3016	my $class = shift;	3379	my $class = shift;
3017		3380
3018	my $self = $class->SUPER::new (	3381	my $self = $class->SUPER::new (
3019	visible => 1,	3382	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3020	@_,	3383	@_,
3021	);	3384	);
3022		3385
3023	Scalar::Util::weaken ($self->{root} = $self);
3024
3025	$self	3386	$self
3026	}	3387	}
3027		3388
3028	sub size_request {	3389	sub set_items {
3029	my ($self) = @_;	3390	my ($self, $items) = @_;
3030		3391
3031	($self->{w}, $self->{h})	3392	$self->{child}->clear;
3032	}	3393	return unless $items;
3033		3394
3034	sub _to_pixel {	3395	my @items = sort {
3035	my ($coord, $size, $max) = @_;	3396	($a->{type} <=> $b->{type})
		3397	or ($a->{name} cmp $b->{name})
		3398	} @$items;
3036		3399
3037	$coord =	3400	$self->{real_items} = \@items;
3038	$coord eq "center" ? ($max - $size) * 0.5
3039	: $coord eq "max" ? $max
3040	: $coord;
3041		3401
3042	$coord = 0 if $coord < 0;	3402	my $row = 0;
3043	$coord = $max - $size if $coord > $max - $size;	3403	for my $item (@items) {
		3404	CFClient::Item::update_widgets $item;
3044		3405
3045	int $coord + 0.5	3406	$self->{child}->add (0, $row, $item->{face_widget});
3046	}	3407	$self->{child}->add (1, $row, $item->{desc_widget});
		3408	$self->{child}->add (2, $row, $item->{weight_widget});
3047		3409
3048	sub size_allocate {	3410	$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	}	3411	}
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	}	3412	}
3212		3413
3213	#############################################################################	3414	#############################################################################
3214		3415
3215	package CFClient::UI::BindEditor;	3416	package CFClient::UI::BindEditor;
…		…
3221		3422
3222	my $self = $class->SUPER::new (binding => [], commands => [], @_);	3423	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3223		3424
3224	$self->add (my $vb = new CFClient::UI::VBox);	3425	$self->add (my $vb = new CFClient::UI::VBox);
3225		3426
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		3427
3236	$vb->add (new CFClient::UI::Label text => "Actions:");
3237	$vb->add ($self->{rec_btn} = new CFClient::UI::Button	3428	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3238	text => "start recording",	3429	text => "start recording",
3239	tooltip => "Start/Stops recording of actions."	3430	tooltip => "Start/Stops recording of actions."
3240	."All subsequent actions after the recording started will be captured."	3431	."All subsequent actions after the recording started will be captured."
3241	."The actions are displayed after the record was stopped."	3432	."The actions are displayed after the record was stopped."
…		…
3246	} else {	3437	} else {
3247	$self->stop;	3438	$self->stop;
3248	}	3439	}
3249	});	3440	});
3250		3441
		3442	$vb->add (new CFClient::UI::Label text => "Actions:");
3251	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);	3443	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3444
		3445	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3446	$vb->add (my $hb = new CFClient::UI::HBox);
		3447	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3448	$hb->add (new CFClient::UI::Button
		3449	text => "bind",
		3450	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3451	on_activate => sub {
		3452	$self->ask_for_bind;
		3453	});
3252		3454
3253	$vb->add (my $hb = new CFClient::UI::HBox);	3455	$vb->add (my $hb = new CFClient::UI::HBox);
3254	$hb->add (new CFClient::UI::Button	3456	$hb->add (new CFClient::UI::Button
3255	text => "ok",	3457	text => "ok",
		3458	expand => 1,
3256	tooltip => "This closes the binding editor and saves the binding",	3459	tooltip => "This closes the binding editor and saves the binding",
3257	on_activate => sub {	3460	on_activate => sub {
3258	$self->hide;	3461	$self->hide;
3259	$self->commit;	3462	$self->commit;
3260	});	3463	});
3261		3464
3262	$hb->add (new CFClient::UI::Button	3465	$hb->add (new CFClient::UI::Button
3263	text => "cancel",	3466	text => "cancel",
		3467	expand => 1,
3264	tooltip => "This closes the binding editor without saving",	3468	tooltip => "This closes the binding editor without saving",
3265	on_activate => sub {	3469	on_activate => sub {
3266	$self->hide;	3470	$self->hide;
3267	$self->{binding_cancel}->()	3471	$self->{binding_cancel}->()
3268	if $self->{binding_cancel};	3472	if $self->{binding_cancel};
…		…
3280	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)	3484	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3281	."'. Don't forget 'Save Config'!");	3485	."'. Don't forget 'Save Config'!");
3282	$self->{binding_change}->($mod, $sym, $cmds)	3486	$self->{binding_change}->($mod, $sym, $cmds)
3283	if $self->{binding_change};	3487	if $self->{binding_change};
3284	} else {	3488	} else {
3285	$::STATUSBOX->add ("No action bound, no keys specified!");	3489	$::STATUSBOX->add ("No action bound, no key or action specified!");
3286	$self->{binding_cancel}->()	3490	$self->{binding_cancel}->()
3287	if $self->{binding_cancel};	3491	if $self->{binding_cancel};
3288	}	3492	}
3289	}	3493	}
3290		3494
…		…
3307	$rec = $::CONN->stop_record if $::CONN;	3511	$rec = $::CONN->stop_record if $::CONN;
3308	return unless ref $rec eq 'ARRAY';	3512	return unless ref $rec eq 'ARRAY';
3309	$self->set_command_list ($rec);	3513	$self->set_command_list ($rec);
3310	}	3514	}
3311		3515
		3516
		3517	sub ask_for_bind_and_commit {
		3518	my ($self) = @_;
		3519	$self->ask_for_bind (1);
		3520	}
		3521
3312	sub ask_for_bind {	3522	sub ask_for_bind {
3313	my ($self, $commit) = @_;	3523	my ($self, $commit, $end_cb) = @_;
3314		3524
3315	CFClient::Binder::open_binding_dialog (sub {	3525	CFClient::Binder::open_binding_dialog (sub {
3316	my ($mod, $sym) = @_;	3526	my ($mod, $sym) = @_;
3317	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?	3527	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3318	$self->update_binding_widgets;	3528	$self->update_binding_widgets;
3319	$self->commit if $commit;	3529	$self->commit if $commit;
		3530	$end_cb->() if $end_cb;
3320	});	3531	});
3321	}	3532	}
3322		3533
		3534	# $mod and $sym are the modifiers and key symbol
		3535	# $cmds is a array ref of strings (the commands)
		3536	# $cb is the callback that is executed on OK
		3537	# $ccb is the callback that is executed on CANCEL and
		3538	# when the binding was unsuccessful on OK
3323	sub set_binding {	3539	sub set_binding {
3324	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;	3540	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3325		3541
3326	$self->clear_command_list;	3542	$self->clear_command_list;
3327	$self->{recording} = 0;	3543	$self->{recording} = 0;
…		…
3332		3548
3333	$self->{binding_change} = $cb;	3549	$self->{binding_change} = $cb;
3334	$self->{binding_cancel} = $ccb;	3550	$self->{binding_cancel} = $ccb;
3335		3551
3336	$self->update_binding_widgets;	3552	$self->update_binding_widgets;
		3553	}
		3554
		3555	# this is a shortcut method that asks for a binding
		3556	# and then just binds it.
		3557	sub do_quick_binding {
		3558	my ($self, $cmds, $end_cb) = @_;
		3559	$self->set_binding (undef, undef, $cmds, sub {
		3560	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3561	});
		3562	$self->ask_for_bind (1, $end_cb);
3337	}	3563	}
3338		3564
3339	sub update_binding_widgets {	3565	sub update_binding_widgets {
3340	my ($self) = @_;	3566	my ($self) = @_;
3341	my ($mod, $sym, $cmds) = $self->get_binding;	3567	my ($mod, $sym, $cmds) = $self->get_binding;
…		…
3367		3593
3368	for (@$cmds) {	3594	for (@$cmds) {
3369	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);	3595	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3370		3596
3371	my $i = $idx;	3597	my $i = $idx;
		3598	$hb->add (new CFClient::UI::Label text => $_);
3372	$hb->add (new CFClient::UI::Button	3599	$hb->add (new CFClient::UI::Button
3373	text => "delete",	3600	text => "delete",
3374	tooltip => "Deletes the action from the record",	3601	tooltip => "Deletes the action from the record",
3375	on_activate => sub {	3602	on_activate => sub {
3376	$self->{cmdbox}->remove ($hb);	3603	$self->{cmdbox}->remove ($hb);
3377	$cmds->[$i] = undef;	3604	$cmds->[$i] = undef;
3378	});	3605	});
3379		3606
3380	$hb->add (new CFClient::UI::Label text => $_);
3381		3607
3382	$idx++	3608	$idx++
3383	}	3609	}
3384	}	3610	}
3385		3611
		3612	#############################################################################
		3613
		3614	package CFClient::UI::SpellList;
		3615
		3616	our @ISA = CFClient::UI::Table::;
		3617
		3618	sub new {
		3619	my $class = shift;
		3620
		3621	my $self = $class->SUPER::new (
		3622	binding => [],
		3623	commands => [],
		3624	@_,
		3625	)
		3626	}
		3627
		3628	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3629
		3630	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3631	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3632	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3633	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3634	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3635	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3636	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3637	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3638	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3639	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3640
		3641	sub rebuild_spell_list {
		3642	my ($self) = @_;
		3643
		3644	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3645	$self->clear;
		3646
		3647	return unless $::CONN;
		3648
		3649	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3650	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3651	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3652	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3653	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3654
		3655	my $row = 0;
		3656
		3657	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3658	my $spell = $self->{spell}{$_};
		3659
		3660	$row++;
		3661
		3662	my $spell_cb = sub {
		3663	my ($widget, $ev) = @_;
		3664
		3665	if ($ev->{button} == 1) {
		3666	$::CONN->user_send ("cast $spell->{name}");
		3667	} elsif ($ev->{button} == 2) {
		3668	$::CONN->user_send ("invoke $spell->{name}");
		3669	} elsif ($ev->{button} == 3) {
		3670	(new CFClient::UI::Menu
		3671	items => [
		3672	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3673	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3674	],
		3675	)->popup ($ev);
		3676	} else {
		3677	return 0;
		3678	}
		3679
		3680	1
		3681	};
		3682
		3683	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3684
		3685	#TODO: add path info to tooltip
		3686	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3687
		3688	$self->add (0, $row, new CFClient::UI::Face
		3689	face => $spell->{face},
		3690	can_hover => 1,
		3691	can_events => 1,
		3692	tooltip => $tooltip,
		3693	on_button_down => $spell_cb,
		3694	);
		3695
		3696	$self->add (1, $row, new CFClient::UI::Label
		3697	expand => 1,
		3698	text => $spell->{name},
		3699	can_hover => 1,
		3700	can_events => 1,
		3701	tooltip => $tooltip,
		3702	on_button_down => $spell_cb,
		3703	);
		3704
		3705	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3706	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3707	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3708	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3709	}
		3710	});
		3711	}
		3712
		3713	sub add_spell {
		3714	my ($self, $spell) = @_;
		3715
		3716	$self->{spell}->{$spell->{name}} = $spell;
		3717	$self->rebuild_spell_list;
		3718	}
		3719
		3720	sub remove_spell {
		3721	my ($self, $spell) = @_;
		3722
		3723	delete $self->{spell}->{$spell->{name}};
		3724	$self->rebuild_spell_list;
		3725	}
		3726
		3727	sub clear_spells {
		3728	my ($self) = @_;
		3729
		3730	$self->{spell} = {};
		3731	$self->rebuild_spell_list;
		3732	}
		3733
		3734	#############################################################################
		3735
		3736	package CFClient::UI::Root;
		3737
		3738	our @ISA = CFClient::UI::Container::;
		3739
		3740	use List::Util qw(min max);
		3741
		3742	use CFClient::OpenGL;
		3743
		3744	sub new {
		3745	my $class = shift;
		3746
		3747	my $self = $class->SUPER::new (
		3748	visible => 1,
		3749	@_,
		3750	);
		3751
		3752	Scalar::Util::weaken ($self->{root} = $self);
		3753
		3754	$self
		3755	}
		3756
		3757	sub size_request {
		3758	my ($self) = @_;
		3759
		3760	($self->{w}, $self->{h})
		3761	}
		3762
		3763	sub _to_pixel {
		3764	my ($coord, $size, $max) = @_;
		3765
		3766	$coord =
		3767	$coord eq "center" ? ($max - $size) * 0.5
		3768	: $coord eq "max" ? $max
		3769	: $coord;
		3770
		3771	$coord = 0 if $coord < 0;
		3772	$coord = $max - $size if $coord > $max - $size;
		3773
		3774	int $coord + 0.5
		3775	}
		3776
		3777	sub size_allocate {
		3778	my ($self, $w, $h) = @_;
		3779
		3780	for my $child ($self->children) {
		3781	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
		3782
		3783	$X = $child->{force_x} if exists $child->{force_x};
		3784	$Y = $child->{force_y} if exists $child->{force_y};
		3785
		3786	$X = _to_pixel $X, $W, $self->{w};
		3787	$Y = _to_pixel $Y, $H, $self->{h};
		3788
		3789	$child->configure ($X, $Y, $W, $H);
		3790	}
		3791	}
		3792
		3793	sub coord2local {
		3794	my ($self, $x, $y) = @_;
		3795
		3796	($x, $y)
		3797	}
		3798
		3799	sub coord2global {
		3800	my ($self, $x, $y) = @_;
		3801
		3802	($x, $y)
		3803	}
		3804
		3805	sub update {
		3806	my ($self) = @_;
		3807
		3808	$::WANT_REFRESH++;
		3809	}
		3810
		3811	sub add {
		3812	my ($self, @children) = @_;
		3813
		3814	$_->{is_toplevel} = 1
		3815	for @children;
		3816
		3817	$self->SUPER::add (@children);
		3818	}
		3819
		3820	sub remove {
		3821	my ($self, @children) = @_;
		3822
		3823	$self->SUPER::remove (@children);
		3824
		3825	delete $self->{is_toplevel}
		3826	for @children;
		3827
		3828	while (@children) {
		3829	my $w = pop @children;
		3830	push @children, $w->children;
		3831	$w->set_invisible;
		3832	}
		3833	}
		3834
		3835	sub on_refresh {
		3836	my ($self, $id, $cb) = @_;
		3837
		3838	$self->{refresh_hook}{$id} = $cb;
		3839	}
		3840
		3841	sub on_post_alloc {
		3842	my ($self, $id, $cb) = @_;
		3843
		3844	$self->{post_alloc_hook}{$id} = $cb;
		3845	}
		3846
		3847	sub draw {
		3848	my ($self) = @_;
		3849
		3850	while ($self->{refresh_hook}) {
		3851	$_->()
		3852	for values %{delete $self->{refresh_hook}};
		3853	}
		3854
		3855	if ($self->{realloc}) {
		3856	my %queue;
		3857	my @queue;
		3858	my $widget;
		3859
		3860	outer:
		3861	while () {
		3862	if (my $realloc = delete $self->{realloc}) {
		3863	for $widget (values %$realloc) {
		3864	$widget->{visible} or next; # do not resize invisible widgets
		3865
		3866	$queue{$widget+0}++ and next; # duplicates are common
		3867
		3868	push @{ $queue[$widget->{visible}] }, $widget;
		3869	}
		3870	}
		3871
		3872	while () {
		3873	@queue or last outer;
		3874
		3875	$widget = pop @{ $queue[-1] || [] }
		3876	and last;
		3877
		3878	pop @queue;
		3879	}
		3880
		3881	delete $queue{$widget+0};
		3882
		3883	my ($w, $h) = $widget->size_request;
		3884
		3885	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3886	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3887
		3888	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3889	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3890
		3891	$w = $widget->{force_w} if exists $widget->{force_w};
		3892	$h = $widget->{force_h} if exists $widget->{force_h};
		3893
		3894	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3895	|| delete $widget->{force_realloc}) {
		3896	$widget->{req_w} = $w;
		3897	$widget->{req_h} = $h;
		3898
		3899	$self->{size_alloc}{$widget+0} = $widget;
		3900
		3901	if (my $parent = $widget->{parent}) {
		3902	$self->{realloc}{$parent+0} = $parent
		3903	unless $queue{$parent+0};
		3904
		3905	$parent->{force_size_alloc} = 1;
		3906	$self->{size_alloc}{$parent+0} = $parent;
		3907	}
		3908	}
		3909
		3910	delete $self->{realloc}{$widget+0};
		3911	}
		3912	}
		3913
		3914	while (my $size_alloc = delete $self->{size_alloc}) {
		3915	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3916	values %$size_alloc;
		3917
		3918	while () {
		3919	my $widget = pop @queue || last;
		3920
		3921	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
		3922
		3923	$w = 0 if $w < 0;
		3924	$h = 0 if $h < 0;
		3925
		3926	$w = int $w + 0.5;
		3927	$h = int $h + 0.5;
		3928
		3929	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3930	$widget->{old_w} = $widget->{w};
		3931	$widget->{old_h} = $widget->{h};
		3932
		3933	$widget->{w} = $w;
		3934	$widget->{h} = $h;
		3935
		3936	$widget->emit (size_allocate => $w, $h);
		3937	}
		3938	}
		3939	}
		3940
		3941	while ($self->{post_alloc_hook}) {
		3942	$_->()
		3943	for values %{delete $self->{post_alloc_hook}};
		3944	}
		3945
		3946
		3947	glViewport 0, 0, $::WIDTH, $::HEIGHT;
		3948	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
		3949	glClear GL_COLOR_BUFFER_BIT;
		3950
		3951	glMatrixMode GL_PROJECTION;
		3952	glLoadIdentity;
		3953	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
		3954	glMatrixMode GL_MODELVIEW;
		3955	glLoadIdentity;
		3956
		3957	{
		3958	package CFClient::UI::Base;
		3959
		3960	($draw_x, $draw_y, $draw_w, $draw_h) =
		3961	(0, 0, $self->{w}, $self->{h});
		3962	}
		3963
		3964	$self->_draw;
		3965	}
3386		3966
3387	#############################################################################	3967	#############################################################################
3388		3968
3389	package CFClient::UI;	3969	package CFClient::UI;
3390		3970

Diff Legend

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