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.258 by root, Tue May 30 02:55:45 2006 UTC vs.
Revision 1.288 by root, Mon Jun 5 21:14:40 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;
…		…
219	$self->connect ($1 => delete $self->{$_});	221	$self->connect ($1 => delete $self->{$_});
220	}	222	}
221	}	223	}
222		224
223	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {	225	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
224	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{w} if exists $layout->{x};	226	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
225	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{h} if exists $layout->{y};	227	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
226	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{w} if exists $layout->{w};	228	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
227	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{h} if exists $layout->{h};	229	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
228		230
229	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};	231	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
230	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};	232	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
231		233
232	$self->show if $layout->{show};	234	$self->show if $layout->{show};
…		…
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);
…		…
355	$self->{x} = $x;	357	$self->{x} = $x;
356	$self->{y} = $y;	358	$self->{y} = $y;
357	$self->update;	359	$self->update;
358	}	360	}
359		361
360	if ($self->{w} != $w || $self->{h} != $h) {	362	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
361	return unless $self->{visible};	363	return unless $self->{visible};
362		364
		365	$self->{alloc_w} = $w;
		366	$self->{alloc_h} = $h;
		367
363	$self->{root}->{size_alloc}{$self+0} = [$self, $w, $h];	368	$self->{root}{size_alloc}{$self+0} = $self;
364	}	369	}
365	}	370	}
366		371
367	sub size_allocate {	372	sub size_allocate {
368	# nothing to be done	373	# nothing to be done
369	}	374	}
370		375
371	sub children {	376	sub children {
		377	# nop
		378	}
		379
		380	sub visible_children {
		381	$_[0]->children
372	}	382	}
373		383
374	sub set_max_size {	384	sub set_max_size {
375	my ($self, $w, $h) = @_;	385	my ($self, $w, $h) = @_;
376		386
377	delete $self->{max_w}; $self->{max_w} = $w if $w;	387	$self->{max_w} = int $w if defined $w;
378	delete $self->{max_h}; $self->{max_h} = $h if $h;	388	$self->{max_h} = int $h if defined $h;
		389
		390	$self->realloc;
379	}	391	}
380		392
381	sub set_tooltip {	393	sub set_tooltip {
382	my ($self, $tooltip) = @_;	394	my ($self, $tooltip) = @_;
383		395
…		…
388		400
389	$self->{tooltip} = $tooltip;	401	$self->{tooltip} = $tooltip;
390		402
391	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	403	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
392	delete $CFClient::UI::TOOLTIP->{owner};	404	delete $CFClient::UI::TOOLTIP->{owner};
393	CFClient::UI::check_tooltip;	405	$CFClient::UI::TOOLTIP_WATCHER->cb->();
394	}	406	}
395	}	407	}
396		408
397	# translate global coordinates to local coordinate system	409	# translate global coordinates to local coordinate system
398	sub coord2local {	410	sub coord2local {
…		…
435		447
436	$::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
437	unless $FOCUS;	449	unless $FOCUS;
438	}	450	}
439		451
440	sub mouse_motion { }	452	sub mouse_motion { 0 }
441	sub button_up { }	453	sub button_up { 0 }
442	sub key_down { }	454	sub key_down { 0 }
443	sub key_up { }	455	sub key_up { 0 }
444		456
445	sub button_down {	457	sub button_down {
446	my ($self, $ev, $x, $y) = @_;	458	my ($self, $ev, $x, $y) = @_;
447		459
448	$self->focus_in;	460	$self->focus_in;
449	}
450		461
451	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	462	0
452	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	463	}
453	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
454	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
455	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
456		464
457	sub find_widget {	465	sub find_widget {
458	my ($self, $x, $y) = @_;	466	my ($self, $x, $y) = @_;
459		467
460	return () unless $self->{can_events};	468	return () unless $self->{can_events};
…		…
498		506
499	sub realloc {	507	sub realloc {
500	my ($self) = @_;	508	my ($self) = @_;
501		509
502	if ($self->{visible}) {	510	if ($self->{visible}) {
503	return if $self->{root}{realloc}{$self};	511	return if $self->{root}{realloc}{$self+0};
504		512
505	$self->{root}{realloc}{$self} = $self;	513	$self->{root}{realloc}{$self+0} = $self;
506	$self->{root}->update;	514	$self->{root}->update;
507	} else {	515	} else {
508	delete $self->{req_w};	516	delete $self->{req_w};
		517	delete $self->{req_h};
509	}	518	}
510	}	519	}
511		520
512	sub update {	521	sub update {
513	my ($self) = @_;	522	my ($self) = @_;
…		…
517	}	526	}
518		527
519	sub reconfigure {	528	sub reconfigure {
520	my ($self) = @_;	529	my ($self) = @_;
521		530
		531	# some widgets cache req_w and req_h
		532	delete $self->{req_w};
		533	delete $self->{req_h};
		534
522	$self->realloc;	535	$self->realloc;
523	$self->update;	536	$self->update;
524	}	537	}
525		538
		539	# using global variables seems a bit hacky, but passing through all drawing
		540	# functions seems pointless.
		541	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
		542
526	sub draw {	543	sub draw {
527	my ($self) = @_;	544	my ($self) = @_;
528		545
529	return unless $self->{h} && $self->{w};	546	return unless $self->{h} && $self->{w};
		547
		548	# update screen rectangle
		549	local $draw_x = $draw_x + $self->{x};
		550	local $draw_y = $draw_y + $self->{y};
		551	local $draw_w = $draw_x + $self->{w};
		552	local $draw_h = $draw_y + $self->{h};
		553
		554	# skip widgets that are entirely outside the drawing area
		555	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		556	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
530		557
531	glPushMatrix;	558	glPushMatrix;
532	glTranslate $self->{x}, $self->{y}, 0;	559	glTranslate $self->{x}, $self->{y}, 0;
533	$self->_draw;
534	glPopMatrix;
535		560
536	if ($self == $HOVER && $self->{can_hover}) {	561	if ($self == $HOVER && $self->{can_hover}) {
537	my ($x, $y) = @$self{qw(x y)};
538
539	glColor 1, 0.8, 0.5, 0.2;	562	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
540	glEnable GL_BLEND;	563	glEnable GL_BLEND;
541	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	564	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
542	glBegin GL_QUADS;	565	glBegin GL_QUADS;
543	glVertex $x , $y;	566	glVertex 0 , 0;
544	glVertex $x + $self->{w}, $y;	567	glVertex $self->{w}, 0;
545	glVertex $x + $self->{w}, $y + $self->{h};	568	glVertex $self->{w}, $self->{h};
546	glVertex $x , $y + $self->{h};	569	glVertex 0 , $self->{h};
547	glEnd;	570	glEnd;
548	glDisable GL_BLEND;	571	glDisable GL_BLEND;
549	}	572	}
550		573
551	if ($ENV{CFPLUS_DEBUG}) {	574	if ($ENV{CFPLUS_DEBUG} & 1) {
552	glPushMatrix;	575	glPushMatrix;
553	glColor 1, 1, 0, 1;	576	glColor 1, 1, 0, 1;
554	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	577	glTranslate 0.375, 0.375;
555	glBegin GL_LINE_LOOP;	578	glBegin GL_LINE_LOOP;
556	glVertex 0 , 0;	579	glVertex 0 , 0;
557	glVertex $self->{w} - 1, 0;	580	glVertex $self->{w} - 1, 0;
558	glVertex $self->{w} - 1, $self->{h} - 1;	581	glVertex $self->{w} - 1, $self->{h} - 1;
559	glVertex 0 , $self->{h} - 1;	582	glVertex 0 , $self->{h} - 1;
560	glEnd;	583	glEnd;
561	glPopMatrix;	584	glPopMatrix;
562	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	585	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
563	}	586	}
		587
		588	$self->_draw;
		589	glPopMatrix;
564	}	590	}
565		591
566	sub _draw {	592	sub _draw {
567	my ($self) = @_;	593	my ($self) = @_;
568		594
…		…
606		632
607	if ($color && (@$color < 4 || $color->[3])) {	633	if ($color && (@$color < 4 || $color->[3])) {
608	my ($w, $h) = @$self{qw(w h)};	634	my ($w, $h) = @$self{qw(w h)};
609		635
610	glEnable GL_BLEND;	636	glEnable GL_BLEND;
611	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	637	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
612	glColor @$color;	638	glColor_premultiply @$color;
613		639
614	glBegin GL_QUADS;	640	glBegin GL_QUADS;
615	glVertex 0 , 0;	641	glVertex 0 , 0;
616	glVertex 0 , $h;	642	glVertex 0 , $h;
617	glVertex $w, $h;	643	glVertex $w, $h;
…		…
648	our @ISA = CFClient::UI::Base::;	674	our @ISA = CFClient::UI::Base::;
649		675
650	sub new {	676	sub new {
651	my ($class, %arg) = @_;	677	my ($class, %arg) = @_;
652		678
653	my $children = delete $arg{children} || [];	679	my $children = delete $arg{children};
654		680
655	my $self = $class->SUPER::new (	681	my $self = $class->SUPER::new (
656	children => [],	682	children => [],
657	can_events => 0,	683	can_events => 0,
658	%arg,	684	%arg,
659	);	685	);
		686
660	$self->add ($_) for @$children;	687	$self->add (@$children)
		688	if $children;
661		689
662	$self	690	$self
663	}	691	}
664		692
665	sub add {	693	sub add {
…		…
713	$x -= $self->{x};	741	$x -= $self->{x};
714	$y -= $self->{y};	742	$y -= $self->{y};
715		743
716	my $res;	744	my $res;
717		745
718	for (reverse @{ $self->{children} }) {	746	for (reverse $self->visible_children) {
719	$res = $_->find_widget ($x, $y)	747	$res = $_->find_widget ($x, $y)
720	and return $res;	748	and return $res;
721	}	749	}
722		750
723	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	751	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
765	sub size_request {	793	sub size_request {
766	$_[0]{children}[0]->size_request	794	$_[0]{children}[0]->size_request
767	}	795	}
768		796
769	sub size_allocate {	797	sub size_allocate {
770	my ($self, $w, $h, $changed) = @_;	798	my ($self, $w, $h) = @_;
771		799
772	$self->{children}[0]->configure (0, 0, $w, $h);	800	$self->{children}[0]->configure (0, 0, $w, $h);
773	}	801	}
774		802
775	#############################################################################	803	#############################################################################
		804
		805	# back-buffered drawing area
776		806
777	package CFClient::UI::Window;	807	package CFClient::UI::Window;
778		808
779	our @ISA = CFClient::UI::Bin::;	809	our @ISA = CFClient::UI::Bin::;
780		810
…		…
792	$ROOT->on_post_alloc ($self => sub { $self->render_child });	822	$ROOT->on_post_alloc ($self => sub { $self->render_child });
793	$self->SUPER::update;	823	$self->SUPER::update;
794	}	824	}
795		825
796	sub size_allocate {	826	sub size_allocate {
797	my ($self, $w, $h, $changed) = @_;	827	my ($self, $w, $h) = @_;
798		828
799	$self->SUPER::size_allocate ($w, $h, $changed);	829	$self->SUPER::size_allocate ($w, $h);
800	$self->update	830	$self->update;
801	if $changed;
802	}	831	}
803		832
804	sub _render {	833	sub _render {
		834	my ($self) = @_;
		835
805	$_[0]{children}[0]->draw;	836	$self->{children}[0]->draw;
806	}	837	}
807		838
808	sub render_child {	839	sub render_child {
809	my ($self) = @_;	840	my ($self) = @_;
810		841
811	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	842	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
812	glClearColor 0, 0, 0, 0;	843	glClearColor 0, 0, 0, 0;
813	glClear GL_COLOR_BUFFER_BIT;	844	glClear GL_COLOR_BUFFER_BIT;
814		845
		846	{
		847	package CFClient::UI::Base;
		848
		849	($draw_x, $draw_y, $draw_w, $draw_h) =
		850	(0, 0, $self->{w}, $self->{h});
		851	}
		852
815	$self->_render;	853	$self->_render;
816	};	854	};
817	}	855	}
818		856
819	sub _draw {	857	sub _draw {
820	my ($self) = @_;	858	my ($self) = @_;
821		859
822	my ($w, $h) = ($self->w, $self->h);	860	my ($w, $h) = @$self{qw(w h)};
823		861
824	my $tex = $self->{texture}	862	my $tex = $self->{texture}
825	or return;	863	or return;
826		864
827	glEnable GL_TEXTURE_2D;	865	glEnable GL_TEXTURE_2D;
828	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	866	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
829	glColor 1, 1, 1, 1;	867	glColor 0, 0, 0, 1;
830		868
831	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	869	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
832		870
833	glDisable GL_TEXTURE_2D;	871	glDisable GL_TEXTURE_2D;
834	}	872	}
…		…
850	}	888	}
851		889
852	sub size_request {	890	sub size_request {
853	my ($self) = @_;	891	my ($self) = @_;
854		892
855	my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	893	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
856		894
857	$w = 10 if $self->{scroll_x};	895	$w = 10 if $self->{scroll_x};
858	$h = 10 if $self->{scroll_y};	896	$h = 10 if $self->{scroll_y};
859		897
860	($w, $h)	898	($w, $h)
861	}	899	}
862		900
863	sub size_allocate {	901	sub size_allocate {
864	my ($self, $w, $h, $changed) = @_;	902	my ($self, $w, $h) = @_;
865		903
		904	my $child = $self->child;
		905
866	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	906	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
867	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	907	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
868		908
869	$self->child->configure (0, 0, $w, $h);	909	$self->child->configure (0, 0, $w, $h);
870	$self->update;	910	$self->update;
871	}	911	}
872		912
…		…
908	}	948	}
909		949
910	sub _render {	950	sub _render {
911	my ($self) = @_;	951	my ($self) = @_;
912		952
		953	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		954	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		955
913	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	956	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
914		957
915	$self->SUPER::_render;	958	$self->SUPER::_render;
916	}	959	}
917		960
…		…
920	package CFClient::UI::ScrolledWindow;	963	package CFClient::UI::ScrolledWindow;
921		964
922	our @ISA = CFClient::UI::HBox::;	965	our @ISA = CFClient::UI::HBox::;
923		966
924	sub new {	967	sub new {
925	my $class = shift;	968	my ($class, %arg) = @_;
		969
		970	my $child = delete $arg{child};
926		971
927	my $self;	972	my $self;
928		973
929	my $slider = new CFClient::UI::Slider	974	my $slider = new CFClient::UI::Slider
930	vertical => 1,	975	vertical => 1,
…		…
935	;	980	;
936		981
937	$self = $class->SUPER::new (	982	$self = $class->SUPER::new (
938	vp => (new CFClient::UI::ViewPort expand => 1),	983	vp => (new CFClient::UI::ViewPort expand => 1),
939	slider => $slider,	984	slider => $slider,
940	@_,	985	%arg,
941	);	986	);
942		987
943	$self->{vp}->add ($self->{scrolled});
944	$self->add ($self->{vp});
945	$self->add ($self->{slider});	988	$self->SUPER::add ($self->{vp}, $self->{slider});
		989	$self->add ($child) if $child;
946		990
947	$self	991	$self
		992	}
		993
		994	sub add {
		995	my ($self, $widget) = @_;
		996
		997	$self->{vp}->add ($self->{child} = $widget);
948	}	998	}
949		999
950	sub update {	1000	sub update {
951	my ($self) = @_;	1001	my ($self) = @_;
952		1002
…		…
956	my $child = $self->{vp}->child;	1006	my $child = $self->{vp}->child;
957	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1007	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
958	}	1008	}
959		1009
960	sub size_allocate {	1010	sub size_allocate {
961	my ($self, $w, $h, $changed) = @_;	1011	my ($self, $w, $h) = @_;
962		1012
963	$self->SUPER::size_allocate ($w, $h, $changed);	1013	$self->SUPER::size_allocate ($w, $h);
964		1014
965	my $child = $self->{vp}->child;	1015	my $child = $self->{vp}->child;
966	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1016	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
967	}	1017	}
968		1018
…		…
991		1041
992	if ($self->{bg}) {	1042	if ($self->{bg}) {
993	my ($w, $h) = @$self{qw(w h)};	1043	my ($w, $h) = @$self{qw(w h)};
994		1044
995	glEnable GL_BLEND;	1045	glEnable GL_BLEND;
996	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1046	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
997	glColor @{ $self->{bg} };	1047	glColor_premultiply @{ $self->{bg} };
998		1048
999	glBegin GL_QUADS;	1049	glBegin GL_QUADS;
1000	glVertex 0 , 0;	1050	glVertex 0 , 0;
1001	glVertex 0 , $h;	1051	glVertex 0 , $h;
1002	glVertex $w, $h;	1052	glVertex $w, $h;
…		…
1024	my @border =	1074	my @border =
1025	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1075	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1026	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1076	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1027		1077
1028	sub new {	1078	sub new {
1029	my $class = shift;	1079	my ($class, %arg) = @_;
		1080
		1081	my $title = delete $arg{title};
1030		1082
1031	my $self = $class->SUPER::new (	1083	my $self = $class->SUPER::new (
1032	bg => [1, 1, 1, 1],	1084	bg => [1, 1, 1, 1],
1033	border_bg => [1, 1, 1, 1],	1085	border_bg => [1, 1, 1, 1],
1034	border => 0.6,	1086	border => 0.6,
1035	can_events => 1,	1087	can_events => 1,
1036	min_w => 16,	1088	min_w => 16,
1037	min_h => 16,	1089	min_h => 16,
1038	@_	1090	%arg,
1039	);	1091	);
1040		1092
1041	$self->{title} &&= new CFClient::UI::Label	1093	$self->{title} = new CFClient::UI::Label
1042	align => 0,	1094	align => 0,
1043	valign => 1,	1095	valign => 1,
1044	text => $self->{title},	1096	text => $title,
1045	fontsize => $self->{border};	1097	fontsize => $self->{border}
		1098	if defined $title;
1046		1099
1047	$self	1100	$self
		1101	}
		1102
		1103	sub add {
		1104	my ($self, @widgets) = @_;
		1105
		1106	$self->SUPER::add (@widgets);
		1107	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
1048	}	1108	}
1049		1109
1050	sub border {	1110	sub border {
1051	int $_[0]{border} * $::FONTSIZE	1111	int $_[0]{border} * $::FONTSIZE
1052	}	1112	}
1053		1113
1054	sub size_request {	1114	sub size_request {
1055	my ($self) = @_;	1115	my ($self) = @_;
		1116
		1117	$self->{title}->size_request
		1118	if $self->{title};
1056		1119
1057	my ($w, $h) = $self->SUPER::size_request;	1120	my ($w, $h) = $self->SUPER::size_request;
1058		1121
1059	(	1122	(
1060	$w + $self->border * 2,	1123	$w + $self->border * 2,
1061	$h + $self->border * 2,	1124	$h + $self->border * 2,
1062	)	1125	)
1063	}	1126	}
1064		1127
1065	sub size_allocate {	1128	sub size_allocate {
1066	my ($self, $w, $h, $changed) = @_;	1129	my ($self, $w, $h) = @_;
1067		1130
1068	return unless $changed;	1131	if ($self->{title}) {
		1132	$self->{title}{w} = $w;
		1133	$self->{title}{h} = $h;
		1134	$self->{title}->size_allocate ($w, $h);
		1135	}
1069		1136
		1137	my $border = $self->border;
		1138
1070	$h -= List::Util::max 0, $self->border * 2;	1139	$h -= List::Util::max 0, $border * 2;
1071	$w -= List::Util::max 0, $self->border * 2;	1140	$w -= List::Util::max 0, $border * 2;
1072		1141
1073	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1074	if $self->{title};
1075
1076	$self->child->configure ($self->border, $self->border, $w, $h);	1142	$self->child->configure ($border, $border, $w, $h);
1077	}	1143	}
1078		1144
1079	sub button_down {	1145	sub button_down {
1080	my ($self, $ev, $x, $y) = @_;	1146	my ($self, $ev, $x, $y) = @_;
1081		1147
…		…
1100	my $dy = $ev->{y} - $oy;	1166	my $dy = $ev->{y} - $oy;
1101		1167
1102	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1168	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1103	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1169	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1104		1170
		1171	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1105	$self->realloc;	1172	$self->realloc;
1106	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1107	};	1173	};
1108		1174
1109	} elsif ($lr ^ $td) {	1175	} elsif ($lr ^ $td) {
1110	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1176	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1111	my ($bx, $by) = ($self->{x}, $self->{y});	1177	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1114	my ($ev, $x, $y) = @_;	1180	my ($ev, $x, $y) = @_;
1115		1181
1116	($x, $y) = ($ev->{x}, $ev->{y});	1182	($x, $y) = ($ev->{x}, $ev->{y});
1117		1183
1118	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1184	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
		1185	# HACK: the next line is required to enforce placement
		1186	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});
1119	};	1187	};
		1188	} else {
		1189	return 0;
		1190	}
		1191
1120	}	1192	1
1121	}	1193	}
1122		1194
1123	sub button_up {	1195	sub button_up {
1124	my ($self, $ev, $x, $y) = @_;	1196	my ($self, $ev, $x, $y) = @_;
1125		1197
1126	delete $self->{motion};	1198	!!delete $self->{motion}
1127	}	1199	}
1128		1200
1129	sub mouse_motion {	1201	sub mouse_motion {
1130	my ($self, $ev, $x, $y) = @_;	1202	my ($self, $ev, $x, $y) = @_;
1131		1203
1132	$self->{motion}->($ev, $x, $y) if $self->{motion};	1204	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1205
		1206	!!$self->{motion}
1133	}	1207	}
1134		1208
1135	sub _draw {	1209	sub _draw {
1136	my ($self) = @_;	1210	my ($self) = @_;
1137		1211
		1212	my $child = $self->{children}[0];
		1213
1138	my ($w, $h ) = ($self->{w}, $self->{h});	1214	my ($w, $h ) = ($self->{w}, $self->{h});
1139	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1215	my ($cw, $ch) = ($child->{w}, $child->{h});
1140		1216
1141	glEnable GL_TEXTURE_2D;	1217	glEnable GL_TEXTURE_2D;
1142	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1218	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1143		1219
1144	my $border = $self->border;	1220	my $border = $self->border;
…		…
1159	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1235	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1160	}	1236	}
1161		1237
1162	glDisable GL_TEXTURE_2D;	1238	glDisable GL_TEXTURE_2D;
1163		1239
1164	$self->{title}->draw if $self->{title};
1165
1166	$self->child->draw;	1240	$child->draw;
		1241
		1242	if ($self->{title}) {
		1243	glTranslate 0, $border - $self->{h};
		1244	$self->{title}->_draw;
		1245	}
1167	}	1246	}
1168		1247
1169	#############################################################################	1248	#############################################################################
1170		1249
1171	package CFClient::UI::Table;	1250	package CFClient::UI::Table;
…		…
1245	(sum @$hs),	1324	(sum @$hs),
1246	)	1325	)
1247	}	1326	}
1248		1327
1249	sub size_allocate {	1328	sub size_allocate {
1250	my ($self, $w, $h, $changed) = @_;	1329	my ($self, $w, $h) = @_;
1251		1330
1252	my ($ws, $hs) = $self->get_wh;	1331	my ($ws, $hs) = $self->get_wh;
1253		1332
1254	my $req_w = (sum @$ws) || 1;	1333	my $req_w = (sum @$ws) || 1;
1255	my $req_h = (sum @$hs) || 1;	1334	my $req_h = (sum @$hs) || 1;
…		…
1333	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1412	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1334	)	1413	)
1335	}	1414	}
1336		1415
1337	sub size_allocate {	1416	sub size_allocate {
1338	my ($self, $w, $h, $changed) = @_;	1417	my ($self, $w, $h) = @_;
1339		1418
1340	my $space = $self->{vertical} ? $h : $w;	1419	my $space = $self->{vertical} ? $h : $w;
1341	my $children = $self->{children};	1420	my $children = $self->{children};
1342		1421
1343	my @req;	1422	my @req;
…		…
1464		1543
1465	delete $self->{texture};	1544	delete $self->{texture};
1466	$self->SUPER::update;	1545	$self->SUPER::update;
1467	}	1546	}
1468		1547
		1548	sub realloc {
		1549	my ($self) = @_;
		1550
		1551	delete $self->{ox};
		1552	$self->SUPER::realloc;
		1553	}
		1554
1469	sub set_text {	1555	sub set_text {
1470	my ($self, $text) = @_;	1556	my ($self, $text) = @_;
1471		1557
1472	return if $self->{text} eq "T$text";	1558	return if $self->{text} eq "T$text";
1473	$self->{text} = "T$text";	1559	$self->{text} = "T$text";
1474		1560
1475	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1561	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1476	$self->{layout}->set_text ($text);	1562	$self->{layout}->set_text ($text);
1477		1563
		1564	delete $self->{req_h};
1478	$self->realloc;	1565	$self->realloc;
1479	$self->update;	1566	$self->update;
1480	}	1567	}
1481		1568
1482	sub set_markup {	1569	sub set_markup {
…		…
1488	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1575	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1489		1576
1490	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1577	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1491	$self->{layout}->set_markup ($markup);	1578	$self->{layout}->set_markup ($markup);
1492		1579
		1580	delete $self->{req_h};
1493	$self->realloc;	1581	$self->realloc;
1494	$self->update;	1582	$self->update;
1495	}	1583	}
1496		1584
1497	sub size_request {	1585	sub size_request {
1498	my ($self) = @_;	1586	my ($self) = @_;
1499		1587
		1588	if (exists $self->{req_h}) {
		1589	@$self{qw(req_w req_h)}
		1590	} else {
1500	$self->{layout}->set_font ($self->{font}) if $self->{font};	1591	$self->{layout}->set_font ($self->{font}) if $self->{font};
1501	$self->{layout}->set_width ($self->{max_w} || -1);	1592	$self->{layout}->set_width ($self->{max_w} || -1);
1502	$self->{layout}->set_ellipsise ($self->{ellipsise});	1593	$self->{layout}->set_ellipsise ($self->{ellipsise});
1503	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1594	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1504	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1595	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1505		1596
1506	my ($w, $h) = $self->{layout}->size;	1597	my ($w, $h) = $self->{layout}->size;
1507		1598
1508	if (exists $self->{template}) {	1599	if (exists $self->{template}) {
1509	$self->{template}->set_font ($self->{font}) if $self->{font};	1600	$self->{template}->set_font ($self->{font}) if $self->{font};
1510	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1601	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1511		1602
1512	my ($w2, $h2) = $self->{template}->size;	1603	my ($w2, $h2) = $self->{template}->size;
1513		1604
1514	$w = List::Util::max $w, $w2;	1605	$w = List::Util::max $w, $w2;
1515	$h = List::Util::max $h, $h2;	1606	$h = List::Util::max $h, $h2;
1516	}	1607	}
1517		1608
1518	($w, $h)	1609	($w, $h)
		1610	}
1519	}	1611	}
1520		1612
1521	sub size_allocate {	1613	sub size_allocate {
1522	my ($self, $w, $h, $changed) = @_;	1614	my ($self, $w, $h) = @_;
		1615
		1616	delete $self->{ox};
1523		1617
1524	delete $self->{texture}	1618	delete $self->{texture}
1525	if $changed;	1619	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1526	}	1620	}
1527		1621
1528	sub set_fontsize {	1622	sub set_fontsize {
1529	my ($self, $fontsize) = @_;	1623	my ($self, $fontsize) = @_;
1530		1624
…		…
1545	$self->{layout}->set_width ($self->{w});	1639	$self->{layout}->set_width ($self->{w});
1546	$self->{layout}->set_ellipsise ($self->{ellipsise});	1640	$self->{layout}->set_ellipsise ($self->{ellipsise});
1547	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1641	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1548	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1642	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1549		1643
1550	my $tex = new_from_layout CFClient::Texture $self->{layout};	1644	new_from_layout CFClient::Texture $self->{layout}
		1645	};
1551		1646
		1647	unless (exists $self->{ox}) {
1552	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1648	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1553	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1649	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1554	: ($self->{w} - $tex->{w}) * 0.5);	1650	: ($self->{w} - $tex->{w}) * 0.5);
1555		1651
1556	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1652	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1557	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1653	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1558	: ($self->{h} - $tex->{h}) * 0.5);	1654	: ($self->{h} - $tex->{h}) * 0.5);
1559
1560	$tex
1561	};	1655	};
1562		1656
1563	glEnable GL_TEXTURE_2D;	1657	glEnable GL_TEXTURE_2D;
1564	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1565		1658
1566	if ($tex->{format} == GL_ALPHA) {	1659	if ($tex->{format} == GL_ALPHA) {
		1660	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1567	glColor @{$self->{fg}};	1661	glColor @{$self->{fg}};
1568	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1662	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1569	} else {	1663	} else {
		1664	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1570	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1665	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1571	}	1666	}
1572		1667
1573	glDisable GL_TEXTURE_2D;	1668	glDisable GL_TEXTURE_2D;
1574	}	1669	}
…		…
1603		1698
1604	delete $self->{cur_h};	1699	delete $self->{cur_h};
1605		1700
1606	return if $self->{text} eq $text;	1701	return if $self->{text} eq $text;
1607		1702
1608	delete $self->{texture};
1609
1610	$self->{last_activity} = $::NOW;	1703	$self->{last_activity} = $::NOW;
1611	$self->{text} = $text;	1704	$self->{text} = $text;
1612		1705
1613	$text =~ s/./*/g if $self->{hidden};	1706	$text =~ s/./*/g if $self->{hidden};
1614	$self->{layout}->set_text ("$text ");	1707	$self->{layout}->set_text ("$text ");
		1708	delete $self->{req_h};
1615		1709
1616	$self->_emit (changed => $self->{text});	1710	$self->_emit (changed => $self->{text});
		1711
		1712	$self->realloc;
		1713	$self->update;
1617	}	1714	}
1618		1715
1619	sub set_text {	1716	sub set_text {
1620	my ($self, $text) = @_;	1717	my ($self, $text) = @_;
1621		1718
1622	$self->{cursor} = length $text;	1719	$self->{cursor} = length $text;
1623	$self->_set_text ($text);	1720	$self->_set_text ($text);
1624
1625	$self->realloc;
1626	}	1721	}
1627		1722
1628	sub get_text {	1723	sub get_text {
1629	$_[0]{text}	1724	$_[0]{text}
1630	}	1725	}
…		…
1660	$self->{cursor} = length $text;	1755	$self->{cursor} = length $text;
1661	} elsif ($uni == 27) {	1756	} elsif ($uni == 27) {
1662	$self->_emit ('escape');	1757	$self->_emit ('escape');
1663	} elsif ($uni) {	1758	} elsif ($uni) {
1664	substr $text, $self->{cursor}++, 0, chr $uni;	1759	substr $text, $self->{cursor}++, 0, chr $uni;
		1760	} else {
		1761	return 0;
1665	}	1762	}
1666		1763
1667	$self->_set_text ($text);	1764	$self->_set_text ($text);
1668		1765
1669	$self->realloc;	1766	$self->realloc;
		1767
		1768	1
1670	}	1769	}
1671		1770
1672	sub focus_in {	1771	sub focus_in {
1673	my ($self) = @_;	1772	my ($self) = @_;
1674		1773
…		…
1689	utf8::encode $text;	1788	utf8::encode $text;
1690	$self->{cursor} = length substr $text, 0, $idx;	1789	$self->{cursor} = length substr $text, 0, $idx;
1691		1790
1692	$self->_set_text ($self->{text});	1791	$self->_set_text ($self->{text});
1693	$self->update;	1792	$self->update;
		1793
		1794	1
1694	}	1795	}
1695		1796
1696	sub mouse_motion {	1797	sub mouse_motion {
1697	my ($self, $ev, $x, $y) = @_;	1798	my ($self, $ev, $x, $y) = @_;
1698	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1799	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1800
		1801	0
1699	}	1802	}
1700		1803
1701	sub _draw {	1804	sub _draw {
1702	my ($self) = @_;	1805	my ($self) = @_;
1703		1806
1704	local $self->{fg} = $self->{fg};	1807	local $self->{fg} = $self->{fg};
1705		1808
1706	if ($FOCUS == $self) {	1809	if ($FOCUS == $self) {
1707	glColor @{$self->{active_bg}};	1810	glColor_premultiply @{$self->{active_bg}};
1708	$self->{fg} = $self->{active_fg};	1811	$self->{fg} = $self->{active_fg};
1709	} else {	1812	} else {
1710	glColor @{$self->{bg}};	1813	glColor_premultiply @{$self->{bg}};
1711	}	1814	}
1712		1815
1713	glEnable GL_BLEND;	1816	glEnable GL_BLEND;
1714	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1817	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1715	glBegin GL_QUADS;	1818	glBegin GL_QUADS;
1716	glVertex 0 , 0;	1819	glVertex 0 , 0;
1717	glVertex 0 , $self->{h};	1820	glVertex 0 , $self->{h};
1718	glVertex $self->{w}, $self->{h};	1821	glVertex $self->{w}, $self->{h};
1719	glVertex $self->{w}, 0;	1822	glVertex $self->{w}, 0;
…		…
1780	} else {	1883	} else {
1781	$self->set_text ($self->{history_saveback});	1884	$self->set_text ($self->{history_saveback});
1782	}	1885	}
1783		1886
1784	} else {	1887	} else {
1785	$self->SUPER::key_down ($ev);	1888	return $self->SUPER::key_down ($ev)
		1889	}
		1890
1786	}	1891	1
1787
1788	}	1892	}
1789		1893
1790	#############################################################################	1894	#############################################################################
1791		1895
1792	package CFClient::UI::Button;	1896	package CFClient::UI::Button;
…		…
1821	my ($self, $ev, $x, $y) = @_;	1925	my ($self, $ev, $x, $y) = @_;
1822		1926
1823	$self->emit ("activate")	1927	$self->emit ("activate")
1824	if $x >= 0 && $x < $self->{w}	1928	if $x >= 0 && $x < $self->{w}
1825	&& $y >= 0 && $y < $self->{h};	1929	&& $y >= 0 && $y < $self->{h};
		1930
		1931	1
1826	}	1932	}
1827		1933
1828	sub _draw {	1934	sub _draw {
1829	my ($self) = @_;	1935	my ($self) = @_;
1830		1936
1831	local $self->{fg} = $self->{fg};	1937	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1832
1833	if ($GRAB == $self) {
1834	$self->{fg} = $self->{active_fg};
1835	}
1836		1938
1837	glEnable GL_TEXTURE_2D;	1939	glEnable GL_TEXTURE_2D;
1838	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1940	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1839	glColor 0, 0, 0, 1;	1941	glColor 0, 0, 0, 1;
1840		1942
…		…
1884		1986
1885	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	1987	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1886	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	1988	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1887	$self->{state} = !$self->{state};	1989	$self->{state} = !$self->{state};
1888	$self->_emit (changed => $self->{state});	1990	$self->_emit (changed => $self->{state});
		1991	} else {
		1992	return 0
		1993	}
		1994
1889	}	1995	1
1890	}	1996	}
1891		1997
1892	sub _draw {	1998	sub _draw {
1893	my ($self) = @_;	1999	my ($self) = @_;
1894		2000
…		…
2061		2167
2062	my $h1 = $self->{h} * (1 - $ycut1);	2168	my $h1 = $self->{h} * (1 - $ycut1);
2063	my $h2 = $self->{h} * (1 - $ycut2);	2169	my $h2 = $self->{h} * (1 - $ycut2);
2064		2170
2065	glEnable GL_BLEND;	2171	glEnable GL_BLEND;
2066	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2172	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2173	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2067	glEnable GL_TEXTURE_2D;	2174	glEnable GL_TEXTURE_2D;
2068	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2175	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2069		2176
2070	glBindTexture GL_TEXTURE_2D, $t1->{name};	2177	glBindTexture GL_TEXTURE_2D, $t1->{name};
2071	glBegin GL_QUADS;	2178	glBegin GL_QUADS;
…		…
2232		2339
2233	$self->SUPER::button_down ($ev, $x, $y);	2340	$self->SUPER::button_down ($ev, $x, $y);
2234		2341
2235	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2342	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2236		2343
2237	$self->mouse_motion ($ev, $x, $y);	2344	$self->mouse_motion ($ev, $x, $y)
2238	}	2345	}
2239		2346
2240	sub mouse_motion {	2347	sub mouse_motion {
2241	my ($self, $ev, $x, $y) = @_;	2348	my ($self, $ev, $x, $y) = @_;
2242		2349
…		…
2246	my (undef, $lo, $hi, $page) = @{$self->{range}};	2353	my (undef, $lo, $hi, $page) = @{$self->{range}};
2247		2354
2248	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2355	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2249		2356
2250	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2357	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2358	} else {
		2359	return 0;
		2360	}
		2361
2251	}	2362	1
2252	}	2363	}
2253		2364
2254	sub update {	2365	sub update {
2255	my ($self) = @_;	2366	my ($self) = @_;
2256		2367
2257	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2368	delete $self->{knob_w};
		2369	$self->SUPER::update;
		2370	}
		2371
		2372	sub _draw {
		2373	my ($self) = @_;
		2374
		2375	unless ($self->{knob_w}) {
2258	$self->set_value ($self->{range}[0]);	2376	$self->set_value ($self->{range}[0]);
2259		2377
2260	my ($value, $lo, $hi, $page) = @{$self->{range}};	2378	my ($value, $lo, $hi, $page) = @{$self->{range}};
2261	my $range = ($hi - $page - $lo) || 1e-100;	2379	my $range = ($hi - $page - $lo) || 1e-100;
2262		2380
…		…
2268	$value = ($value - $lo) / $range;	2386	$value = ($value - $lo) / $range;
2269	$value = $value * $self->{scale} + $self->{offset};	2387	$value = $value * $self->{scale} + $self->{offset};
2270		2388
2271	$self->{knob_x} = $value - $knob_w * 0.5;	2389	$self->{knob_x} = $value - $knob_w * 0.5;
2272	$self->{knob_w} = $knob_w;	2390	$self->{knob_w} = $knob_w;
2273	});	2391	}
2274
2275	$self->SUPER::update;
2276	}
2277
2278	sub _draw {
2279	my ($self) = @_;
2280		2392
2281	$self->SUPER::_draw ();	2393	$self->SUPER::_draw ();
2282		2394
2283	glScale $self->{w}, $self->{h};	2395	glScale $self->{w}, $self->{h};
2284		2396
…		…
2382	$self->{fontsize} = $fontsize;	2494	$self->{fontsize} = $fontsize;
2383	$self->reflow;	2495	$self->reflow;
2384	}	2496	}
2385		2497
2386	sub size_allocate {	2498	sub size_allocate {
2387	my ($self, $w, $h, $changed) = @_;	2499	my ($self, $w, $h) = @_;
2388		2500
2389	$self->SUPER::size_allocate ($w, $h, $changed);	2501	$self->SUPER::size_allocate ($w, $h);
2390
2391	return unless $changed;
2392		2502
2393	$self->{layout}->set_font ($self->{font}) if $self->{font};	2503	$self->{layout}->set_font ($self->{font}) if $self->{font};
2394	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2504	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2395	$self->{layout}->set_width ($self->{children}[0]{w});	2505	$self->{layout}->set_width ($self->{children}[0]{w});
2396		2506
…		…
2480		2590
2481	delete $self->{texture};	2591	delete $self->{texture};
2482	}	2592	}
2483		2593
2484	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2594	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2485	glClearColor 0.5, 0.5, 0.5, 0;	2595	glClearColor 0, 0, 0, 0;
2486	glClear GL_COLOR_BUFFER_BIT;	2596	glClear GL_COLOR_BUFFER_BIT;
2487		2597
2488	my $top = int $self->{children}[1]{range}[0];	2598	my $top = int $self->{children}[1]{range}[0];
2489		2599
2490	my $y0 = $top;	2600	my $y0 = $top;
…		…
2525	sub _draw {	2635	sub _draw {
2526	my ($self) = @_;	2636	my ($self) = @_;
2527		2637
2528	glEnable GL_TEXTURE_2D;	2638	glEnable GL_TEXTURE_2D;
2529	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2639	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2530	glColor 1, 1, 1, 1;	2640	glColor 0, 0, 0, 1;
2531	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2641	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2532	glDisable GL_TEXTURE_2D;	2642	glDisable GL_TEXTURE_2D;
2533		2643
2534	$self->{children}[1]->draw;	2644	$self->{children}[1]->draw;
2535		2645
2536	}	2646	}
…		…
2619	}	2729	}
2620		2730
2621	sub set_tooltip_from {	2731	sub set_tooltip_from {
2622	my ($self, $widget) = @_;	2732	my ($self, $widget) = @_;
2623		2733
		2734	my $tooltip = $widget->{tooltip};
		2735
		2736	if ($ENV{CFPLUS_DEBUG} & 2) {
		2737	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2738	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2739	. "req $widget->{req_w} $widget->{req_h}\n"
		2740	. "visible $widget->{visible}";
		2741	}
		2742
2624	$self->add (new CFClient::UI::Label	2743	$self->add (new CFClient::UI::Label
2625	markup => $widget->{tooltip},	2744	markup => $tooltip,
2626	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2745	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2627	fontsize => 0.8,	2746	fontsize => 0.8,
2628	fg => [0, 0, 0, 1],	2747	fg => [0, 0, 0, 1],
2629	ellipsise => 0,	2748	ellipsise => 0,
2630	font => ($widget->{tooltip_font} || $::FONT_PROP),	2749	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2638		2757
2639	($w + 4, $h + 4)	2758	($w + 4, $h + 4)
2640	}	2759	}
2641		2760
2642	sub size_allocate {	2761	sub size_allocate {
2643	my ($self, $w, $h, $changed) = @_;	2762	my ($self, $w, $h) = @_;
2644		2763
2645	return unless $changed;
2646
2647	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2764	$self->SUPER::size_allocate ($w - 4, $h - 4);
2648	}	2765	}
2649		2766
2650	sub visibility_change {	2767	sub visibility_change {
2651	my ($self, $visible) = @_;	2768	my ($self, $visible) = @_;
2652		2769
…		…
2756	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2873	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2757		2874
2758	if ($tex) {	2875	if ($tex) {
2759	glEnable GL_TEXTURE_2D;	2876	glEnable GL_TEXTURE_2D;
2760	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2877	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2761	glColor 1, 1, 1, 1;	2878	glColor 0, 0, 0, 1;
2762	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2879	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2763	glDisable GL_TEXTURE_2D;	2880	glDisable GL_TEXTURE_2D;
2764	}	2881	}
2765	}	2882	}
2766		2883
…		…
2773	$self->SUPER::DESTROY;	2890	$self->SUPER::DESTROY;
2774	}	2891	}
2775		2892
2776	#############################################################################	2893	#############################################################################
2777		2894
2778	package CFClient::UI::Inventory;	2895	package CFClient::UI::Buttonbar;
2779		2896
2780	our @ISA = CFClient::UI::ScrolledWindow::;	2897	our @ISA = CFClient::UI::HBox::;
2781		2898
2782	sub new {	2899	# TODO: should actualyl wrap buttons and other goodies.
2783	my $class = shift;
2784
2785	my $self = $class->SUPER::new (
2786	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2787	@_,
2788	);
2789
2790	$self
2791	}
2792
2793	sub set_items {
2794	my ($self, $items) = @_;
2795
2796	$self->{scrolled}->clear;
2797	return unless $items;
2798
2799	my @items = sort {
2800	($a->{type} <=> $b->{type})
2801	or ($a->{name} cmp $b->{name})
2802	} @$items;
2803
2804	$self->{real_items} = \@items;
2805
2806	my $row = 0;
2807	for my $item (@items) {
2808	CFClient::Item::update_widgets $item;
2809
2810	$self->{scrolled}->add (0, $row, $item->{face_widget});
2811	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2812	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2813
2814	$row++;
2815	}
2816	}
2817		2900
2818	#############################################################################	2901	#############################################################################
2819		2902
2820	package CFClient::UI::Menu;	2903	package CFClient::UI::Menu;
2821		2904
…		…
2871	my ($self, $ev, $x, $y) = @_;	2954	my ($self, $ev, $x, $y) = @_;
2872		2955
2873	# TODO: should use vbox->find_widget or so	2956	# TODO: should use vbox->find_widget or so
2874	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2957	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2875	$self->{hover} = $self->{item}{$HOVER};	2958	$self->{hover} = $self->{item}{$HOVER};
		2959
		2960	0
2876	}	2961	}
2877		2962
2878	sub button_up {	2963	sub button_up {
2879	my ($self, $ev, $x, $y) = @_;	2964	my ($self, $ev, $x, $y) = @_;
2880		2965
…		…
2882	undef $GRAB;	2967	undef $GRAB;
2883	$self->hide;	2968	$self->hide;
2884		2969
2885	$self->_emit ("popdown");	2970	$self->_emit ("popdown");
2886	$self->{hover}[1]->() if $self->{hover};	2971	$self->{hover}[1]->() if $self->{hover};
		2972	} else {
		2973	return 0
		2974	}
		2975
2887	}	2976	1
2888	}	2977	}
2889		2978
2890	#############################################################################	2979	#############################################################################
2891		2980
2892	package CFClient::UI::Statusbox;	2981	package CFClient::UI::Multiplexer;
2893		2982
2894	our @ISA = CFClient::UI::VBox::;	2983	our @ISA = CFClient::UI::Container::;
2895		2984
2896	sub new {	2985	sub new {
2897	my $class = shift;	2986	my $class = shift;
2898		2987
2899	$class->SUPER::new (	2988	my $self = $class->SUPER::new (
		2989	@_,
		2990	);
		2991
		2992	$self->{current} = $self->{children}[0]
		2993	if @{ $self->{children} };
		2994
		2995	$self
		2996	}
		2997
		2998	sub add {
		2999	my ($self, @widgets) = @_;
		3000
		3001	$self->SUPER::add (@widgets);
		3002
		3003	$self->{current} = $self->{children}[0]
		3004	if @{ $self->{children} };
		3005	}
		3006
		3007	sub set_current_page {
		3008	my ($self, $page_or_widget) = @_;
		3009
		3010	my $widget = ref $page_or_widget
		3011	? $page_or_widget
		3012	: $self->{children}[$page_or_widget];
		3013
		3014	$self->{current} = $widget;
		3015	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3016
		3017	$self->_emit (page_changed => $self->{current});
		3018
		3019	$self->realloc;
		3020	}
		3021
		3022	sub visible_children {
		3023	$_[0]{current}
		3024	}
		3025
		3026	sub size_request {
		3027	my ($self) = @_;
		3028
		3029	$self->{current}->size_request
		3030	}
		3031
		3032	sub size_allocate {
		3033	my ($self, $w, $h) = @_;
		3034
		3035	$self->{current}->configure (0, 0, $w, $h);
		3036	}
		3037
		3038	sub _draw {
		3039	my ($self) = @_;
		3040
		3041	$self->{current}->draw;
		3042	}
		3043
		3044	#############################################################################
		3045
		3046	package CFClient::UI::Notebook;
		3047
		3048	our @ISA = CFClient::UI::VBox::;
		3049
		3050	sub new {
		3051	my $class = shift;
		3052
		3053	my $self = $class->SUPER::new (
		3054	buttonbar => (new CFClient::UI::Buttonbar),
		3055	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3056	# filter => # will be put between multiplexer and $self
		3057	@_,
		3058	);
		3059
		3060	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3061	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3062
		3063	$self
		3064	}
		3065
		3066	sub add {
		3067	my ($self, $title, $widget, $tooltip) = @_;
		3068
		3069	Scalar::Util::weaken $self;
		3070
		3071	$self->{buttonbar}->add (new CFClient::UI::Button
		3072	markup => $title,
		3073	tooltip => $tooltip,
		3074	on_activate => sub { $self->set_current_page ($widget) },
		3075	);
		3076
		3077	$self->{multiplexer}->add ($widget);
		3078	}
		3079
		3080	sub set_current_page {
		3081	my ($self, $page) = @_;
		3082
		3083	$self->{multiplexer}->set_current_page ($page);
		3084	$self->_emit (page_changed => $self->{multiplexer}{current});
		3085	}
		3086
		3087	#############################################################################
		3088
		3089	package CFClient::UI::Statusbox;
		3090
		3091	our @ISA = CFClient::UI::VBox::;
		3092
		3093	sub new {
		3094	my $class = shift;
		3095
		3096	my $self = $class->SUPER::new (
2900	fontsize => 0.8,	3097	fontsize => 0.8,
2901	@_,	3098	@_,
2902	)	3099	);
		3100
		3101	Scalar::Util::weaken (my $this = $self);
		3102
		3103	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3104
		3105	$self
2903	}	3106	}
2904		3107
2905	sub reorder {	3108	sub reorder {
2906	my ($self) = @_;	3109	my ($self) = @_;
2907	my $NOW = time;	3110	my $NOW = Time::HiRes::time;
		3111
		3112	# freeze display when hovering over any label
		3113	return if $CFClient::UI::TOOLTIP->{owner}
		3114	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3115	values %{ $self->{item} };
2908		3116
2909	while (my ($k, $v) = each %{ $self->{item} }) {	3117	while (my ($k, $v) = each %{ $self->{item} }) {
2910	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3118	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2911	}	3119	}
2912		3120
…		…
2915	my @items = sort {	3123	my @items = sort {
2916	$a->{pri} <=> $b->{pri}	3124	$a->{pri} <=> $b->{pri}
2917	or $b->{id} <=> $a->{id}	3125	or $b->{id} <=> $a->{id}
2918	} values %{ $self->{item} };	3126	} values %{ $self->{item} };
2919		3127
		3128	$self->{timer}->interval (1);
		3129
2920	my $count = 10 + 1;	3130	my $count = 10 + 1;
2921	for my $item (@items) {	3131	for my $item (@items) {
2922	last unless --$count;	3132	last unless --$count;
2923		3133
2924	push @widgets, $item->{label} ||= do {	3134	my $label = $item->{label} ||= do {
2925	# TODO: doesn't handle markup well (read as: at all)	3135	# TODO: doesn't handle markup well (read as: at all)
2926	my $short = $item->{count} > 1	3136	my $short = $item->{count} > 1
2927	? "<b>$item->{count} ×</b> $item->{text}"	3137	? "<b>$item->{count} ×</b> $item->{text}"
2928	: $item->{text};	3138	: $item->{text};
2929		3139
…		…
2937	tooltip => $item->{tooltip},	3147	tooltip => $item->{tooltip},
2938	tooltip_font => $::FONT_PROP,	3148	tooltip_font => $::FONT_PROP,
2939	tooltip_width => 0.67,	3149	tooltip_width => 0.67,
2940	fontsize => $item->{fontsize} || $self->{fontsize},	3150	fontsize => $item->{fontsize} || $self->{fontsize},
2941	max_w => $::WIDTH * 0.44,	3151	max_w => $::WIDTH * 0.44,
2942	fg => $item->{fg},	3152	fg => [@{ $item->{fg} }],
2943	can_events => 1,	3153	can_events => 1,
2944	can_hover => 1	3154	can_hover => 1
2945	};	3155	};
		3156
		3157	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3158	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3159	$label->update;
		3160	$label->set_max_size (undef, $label->{req_h} * $diff)
		3161	if $diff < 1;
		3162	$self->{timer}->interval (1/30);
		3163	} else {
		3164	$label->{fg}[3] = $item->{fg}[3] || 1;
		3165	}
		3166
		3167	push @widgets, $label;
2946	}	3168	}
2947		3169
2948	$self->clear;	3170	$self->clear;
2949	$self->SUPER::add (reverse @widgets);	3171	$self->SUPER::add (reverse @widgets);
2950	}	3172	}
…		…
2955	$text =~ s/^\s+//;	3177	$text =~ s/^\s+//;
2956	$text =~ s/\s+$//;	3178	$text =~ s/\s+$//;
2957		3179
2958	return unless $text;	3180	return unless $text;
2959		3181
2960	my $timeout = time + ((delete $arg{timeout}) || 60);	3182	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2961		3183
2962	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3184	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2963		3185
2964	if (my $item = $self->{item}{$group}) {	3186	if (my $item = $self->{item}{$group}) {
2965	if ($item->{text} eq $text) {	3187	if ($item->{text} eq $text) {
…		…
2995		3217
2996	$self->reorder;	3218	$self->reorder;
2997	$self->SUPER::reconfigure;	3219	$self->SUPER::reconfigure;
2998	}	3220	}
2999		3221
		3222	sub DESTROY {
		3223	my ($self) = @_;
		3224
		3225	$self->{timer}->cancel;
		3226
		3227	$self->SUPER::DESTROY;
		3228	}
		3229
3000	#############################################################################	3230	#############################################################################
3001		3231
		3232	package CFClient::UI::Inventory;
		3233
		3234	our @ISA = CFClient::UI::ScrolledWindow::;
		3235
		3236	sub new {
		3237	my $class = shift;
		3238
		3239	my $self = $class->SUPER::new (
		3240	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3241	@_,
		3242	);
		3243
		3244	$self
		3245	}
		3246
		3247	sub set_items {
		3248	my ($self, $items) = @_;
		3249
		3250	$self->{child}->clear;
		3251	return unless $items;
		3252
		3253	my @items = sort {
		3254	($a->{type} <=> $b->{type})
		3255	or ($a->{name} cmp $b->{name})
		3256	} @$items;
		3257
		3258	$self->{real_items} = \@items;
		3259
		3260	my $row = 0;
		3261	for my $item (@items) {
		3262	CFClient::Item::update_widgets $item;
		3263
		3264	$self->{child}->add (0, $row, $item->{face_widget});
		3265	$self->{child}->add (1, $row, $item->{desc_widget});
		3266	$self->{child}->add (2, $row, $item->{weight_widget});
		3267
		3268	$row++;
		3269	}
		3270	}
		3271
		3272	#############################################################################
		3273
		3274	package CFClient::UI::BindEditor;
		3275
		3276	our @ISA = CFClient::UI::FancyFrame::;
		3277
		3278	sub new {
		3279	my $class = shift;
		3280
		3281	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3282
		3283	$self->add (my $vb = new CFClient::UI::VBox);
		3284
		3285
		3286	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3287	text => "start recording",
		3288	tooltip => "Start/Stops recording of actions."
		3289	."All subsequent actions after the recording started will be captured."
		3290	."The actions are displayed after the record was stopped."
		3291	."To bind the action you have to click on the 'Bind' button",
		3292	on_activate => sub {
		3293	unless ($self->{recording}) {
		3294	$self->start;
		3295	} else {
		3296	$self->stop;
		3297	}
		3298	});
		3299
		3300	$vb->add (new CFClient::UI::Label text => "Actions:");
		3301	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3302
		3303	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3304	$vb->add (my $hb = new CFClient::UI::HBox);
		3305	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3306	$hb->add (new CFClient::UI::Button
		3307	text => "bind",
		3308	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3309	on_activate => sub {
		3310	$self->ask_for_bind;
		3311	});
		3312
		3313	$vb->add (my $hb = new CFClient::UI::HBox);
		3314	$hb->add (new CFClient::UI::Button
		3315	text => "ok",
		3316	expand => 1,
		3317	tooltip => "This closes the binding editor and saves the binding",
		3318	on_activate => sub {
		3319	$self->hide;
		3320	$self->commit;
		3321	});
		3322
		3323	$hb->add (new CFClient::UI::Button
		3324	text => "cancel",
		3325	expand => 1,
		3326	tooltip => "This closes the binding editor without saving",
		3327	on_activate => sub {
		3328	$self->hide;
		3329	$self->{binding_cancel}->()
		3330	if $self->{binding_cancel};
		3331	});
		3332
		3333	$self->update_binding_widgets;
		3334
		3335	$self
		3336	}
		3337
		3338	sub commit {
		3339	my ($self) = @_;
		3340	my ($mod, $sym, $cmds) = $self->get_binding;
		3341	if ($sym != 0 && @$cmds > 0) {
		3342	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3343	."'. Don't forget 'Save Config'!");
		3344	$self->{binding_change}->($mod, $sym, $cmds)
		3345	if $self->{binding_change};
		3346	} else {
		3347	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3348	$self->{binding_cancel}->()
		3349	if $self->{binding_cancel};
		3350	}
		3351	}
		3352
		3353	sub start {
		3354	my ($self) = @_;
		3355
		3356	$self->{rec_btn}->set_text ("stop recording");
		3357	$self->{recording} = 1;
		3358	$self->clear_command_list;
		3359	$::CONN->start_record if $::CONN;
		3360	}
		3361
		3362	sub stop {
		3363	my ($self) = @_;
		3364
		3365	$self->{rec_btn}->set_text ("start recording");
		3366	$self->{recording} = 0;
		3367
		3368	my $rec;
		3369	$rec = $::CONN->stop_record if $::CONN;
		3370	return unless ref $rec eq 'ARRAY';
		3371	$self->set_command_list ($rec);
		3372	}
		3373
		3374
		3375	sub ask_for_bind_and_commit {
		3376	my ($self) = @_;
		3377	$self->ask_for_bind (1);
		3378	}
		3379
		3380	sub ask_for_bind {
		3381	my ($self, $commit) = @_;
		3382
		3383	CFClient::Binder::open_binding_dialog (sub {
		3384	my ($mod, $sym) = @_;
		3385	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3386	$self->update_binding_widgets;
		3387	$self->commit if $commit;
		3388	});
		3389	}
		3390
		3391	# $mod and $sym are the modifiers and key symbol
		3392	# $cmds is a array ref of strings (the commands)
		3393	# $cb is the callback that is executed on OK
		3394	# $ccb is the callback that is executed on CANCEL and
		3395	# when the binding was unsuccessful on OK
		3396	sub set_binding {
		3397	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3398
		3399	$self->clear_command_list;
		3400	$self->{recording} = 0;
		3401	$self->{rec_btn}->set_text ("start recording");
		3402
		3403	$self->{binding} = [$mod, $sym];
		3404	$self->{commands} = $cmds;
		3405
		3406	$self->{binding_change} = $cb;
		3407	$self->{binding_cancel} = $ccb;
		3408
		3409	$self->update_binding_widgets;
		3410	}
		3411
		3412	# this is a shortcut method that asks for a binding
		3413	# and then just binds it.
		3414	sub do_quick_binding {
		3415	my ($self, $cmds) = @_;
		3416	$self->set_binding (undef, undef, $cmds, sub {
		3417	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3418	});
		3419	$self->ask_for_bind (1);
		3420	}
		3421
		3422	sub update_binding_widgets {
		3423	my ($self) = @_;
		3424	my ($mod, $sym, $cmds) = $self->get_binding;
		3425	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3426	$self->set_command_list ($cmds);
		3427	}
		3428
		3429	sub get_binding {
		3430	my ($self) = @_;
		3431	return (
		3432	$self->{binding}->[0],
		3433	$self->{binding}->[1],
		3434	[ grep { defined $_ } @{$self->{commands}} ]
		3435	);
		3436	}
		3437
		3438	sub clear_command_list {
		3439	my ($self) = @_;
		3440	$self->{cmdbox}->clear ();
		3441	}
		3442
		3443	sub set_command_list {
		3444	my ($self, $cmds) = @_;
		3445
		3446	$self->{cmdbox}->clear ();
		3447	$self->{commands} = $cmds;
		3448
		3449	my $idx = 0;
		3450
		3451	for (@$cmds) {
		3452	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3453
		3454	my $i = $idx;
		3455	$hb->add (new CFClient::UI::Label text => $_);
		3456	$hb->add (new CFClient::UI::Button
		3457	text => "delete",
		3458	tooltip => "Deletes the action from the record",
		3459	on_activate => sub {
		3460	$self->{cmdbox}->remove ($hb);
		3461	$cmds->[$i] = undef;
		3462	});
		3463
		3464
		3465	$idx++
		3466	}
		3467	}
		3468
		3469	#############################################################################
		3470
		3471	package CFClient::UI::SpellList;
		3472
		3473	our @ISA = CFClient::UI::Table::;
		3474
		3475	sub new {
		3476	my $class = shift;
		3477
		3478	my $self = $class->SUPER::new (
		3479	binding => [],
		3480	commands => [],
		3481	@_,
		3482	)
		3483	}
		3484
		3485	# XXX: Do sorting? Argl...
		3486	sub add_spell {
		3487	my ($self, $spell) = @_;
		3488	$self->{spells}->{$spell->{name}} = $spell;
		3489
		3490	$self->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3491	face => $spell->{face},
		3492	can_hover => 1,
		3493	can_events => 1,
		3494	tooltip => $spell->{message});
		3495
		3496	$self->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3497	text => $spell->{name},
		3498	can_hover => 1,
		3499	can_events => 1,
		3500	tooltip => $spell->{message},
		3501	expand => 1);
		3502
		3503	$self->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3504	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3505	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3506	expand => 1);
		3507
		3508	$self->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3509	text => "bind to key",
		3510	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3511	}
		3512
		3513	sub rebuild_spell_list {
		3514	my ($self) = @_;
		3515	$self->{tbl_idx} = 0;
		3516	$self->add_spell ($_) for values %{$self->{spells}};
		3517	}
		3518
		3519	sub remove_spell {
		3520	my ($self, $spell) = @_;
		3521	delete $self->{spells}->{$spell->{name}};
		3522	$self->rebuild_spell_list;
		3523	}
		3524
		3525	#############################################################################
		3526
3002	package CFClient::UI::Root;	3527	package CFClient::UI::Root;
3003		3528
3004	our @ISA = CFClient::UI::Container::;	3529	our @ISA = CFClient::UI::Container::;
		3530
		3531	use List::Util qw(min max);
3005		3532
3006	use CFClient::OpenGL;	3533	use CFClient::OpenGL;
3007		3534
3008	sub new {	3535	sub new {
3009	my $class = shift;	3536	my $class = shift;
…		…
3016	Scalar::Util::weaken ($self->{root} = $self);	3543	Scalar::Util::weaken ($self->{root} = $self);
3017		3544
3018	$self	3545	$self
3019	}	3546	}
3020		3547
3021	sub configure {
3022	my ($self, $x, $y, $w, $h) = @_;
3023
3024	$self->{w} = $w;
3025	$self->{h} = $h;
3026	}
3027
3028	sub reconfigure {
3029	my ($self) = @_;
3030
3031	$self->SUPER::reconfigure;
3032
3033	$self->size_allocate ($self->{w}, $self->{h}, 1)
3034	if $self->{w};
3035	}
3036
3037	sub size_request {	3548	sub size_request {
3038	my ($self) = @_;	3549	my ($self) = @_;
3039		3550
3040	($self->{w}, $self->{h})	3551	($self->{w}, $self->{h})
3041	}	3552	}
…		…
3053		3564
3054	int $coord + 0.5	3565	int $coord + 0.5
3055	}	3566	}
3056		3567
3057	sub size_allocate {	3568	sub size_allocate {
3058	my ($self, $w, $h, $changed) = @_;	3569	my ($self, $w, $h) = @_;
3059		3570
3060	for my $child ($self->children) {	3571	for my $child ($self->children) {
3061	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3572	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3062		3573
3063	$X = $child->{force_x} if exists $child->{force_x};	3574	$X = $child->{force_x} if exists $child->{force_x};
…		…
3131	$_->()	3642	$_->()
3132	for values %{delete $self->{refresh_hook}};	3643	for values %{delete $self->{refresh_hook}};
3133	}	3644	}
3134		3645
3135	if ($self->{realloc}) {	3646	if ($self->{realloc}) {
		3647	my %queue;
3136	my @queue;	3648	my @queue;
		3649	my $widget;
3137		3650
		3651	outer:
3138	while () {	3652	while () {
3139	if ($self->{realloc}) {	3653	if (my $realloc = delete $self->{realloc}) {
3140	#TODO use array-of-depth approach	3654	for $widget (values %$realloc) {
		3655	$widget->{visible} or next; # do not resize invisible widgets
3141		3656
3142	@queue = sort { $a->{visible} <=> $b->{visible} }	3657	$queue{$widget+0}++ and next; # duplicates are common
3143	@queue, values %{delete $self->{realloc}};	3658
		3659	push @{ $queue[$widget->{visible}] }, $widget;
		3660	}
3144	}	3661	}
3145		3662
		3663	while () {
		3664	@queue or last outer;
		3665
3146	my $widget = pop @queue || last;	3666	$widget = pop @{ $queue[-1] || [] }
		3667	and last;
		3668
		3669	pop @queue;
		3670	}
3147		3671
3148	$widget->{visible} or last; # do not resize invisible widgets	3672	delete $queue{$widget+0};
3149		3673
3150	my ($w, $h) = $widget->size_request;	3674	my ($w, $h) = $widget->size_request;
3151		3675
3152	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;	3676	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3153	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;	3677	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3678
		3679	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3680	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3154		3681
3155	$w = $widget->{force_w} if exists $widget->{force_w};	3682	$w = $widget->{force_w} if exists $widget->{force_w};
3156	$h = $widget->{force_h} if exists $widget->{force_h};	3683	$h = $widget->{force_h} if exists $widget->{force_h};
3157		3684
		3685	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3686	|| delete $widget->{force_realloc}) {
3158	$widget->{req_w} = $w;	3687	$widget->{req_w} = $w;
3159	$widget->{req_h} = $h;	3688	$widget->{req_h} = $h;
3160		3689
3161	$self->{size_alloc}{$widget} = [$widget, undef, undef];	3690	$self->{size_alloc}{$widget+0} = $widget;
3162		3691
3163	push @queue, $widget->{parent}	3692	if (my $parent = $widget->{parent}) {
3164	if ($self->{w} != $w || $self->{h} != $h) && $widget->{parent};	3693	$self->{realloc}{$parent+0} = $parent
		3694	unless $queue{$parent+0};
		3695
		3696	$parent->{force_size_alloc} = 1;
		3697	$self->{size_alloc}{$parent+0} = $parent;
		3698	}
		3699	}
		3700
		3701	delete $self->{realloc}{$widget+0};
3165	}	3702	}
3166	}	3703	}
3167		3704
3168	while (my $size_alloc = delete $self->{size_alloc}) {	3705	while (my $size_alloc = delete $self->{size_alloc}) {
3169	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3706	my @queue = sort { $b->{visible} <=> $a->{visible} }
3170	values %$size_alloc;	3707	values %$size_alloc;
3171		3708
3172	while () {	3709	while () {
3173	my ($widget, $w, $h) = @{ pop @queue or last };	3710	my $widget = pop @queue || last;
3174		3711
3175	$w = $widget->{w} || $widget->{req_w} unless defined $w;	3712	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3176	$h = $widget->{h} || $widget->{req_h} unless defined $h;
3177		3713
3178	$w = 0 if $w < 0;	3714	$w = 0 if $w < 0;
3179	$h = 0 if $h < 0;	3715	$h = 0 if $h < 0;
3180		3716
3181	$w = int $w + 0.5;	3717	$w = int $w + 0.5;
3182	$h = int $h + 0.5;	3718	$h = int $h + 0.5;
3183		3719
3184	my $changed = $widget->{w} != $w || $widget->{h} != $h;	3720	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3721	$widget->{old_w} = $widget->{w};
		3722	$widget->{old_h} = $widget->{h};
3185		3723
3186	$widget->{w} = $w;	3724	$widget->{w} = $w;
3187	$widget->{h} = $h;	3725	$widget->{h} = $h;
3188		3726
3189	$widget->emit (size_allocate => $w, $h, $changed);	3727	$widget->emit (size_allocate => $w, $h);
		3728	}
3190	}	3729	}
3191	}	3730	}
3192		3731
3193	while ($self->{post_alloc_hook}) {	3732	while ($self->{post_alloc_hook}) {
3194	$_->()	3733	$_->()
3195	for values %{delete $self->{post_alloc_hook}};	3734	for values %{delete $self->{post_alloc_hook}};
3196	}	3735	}
		3736
3197		3737
3198	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3738	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3199	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3739	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3200	glClear GL_COLOR_BUFFER_BIT;	3740	glClear GL_COLOR_BUFFER_BIT;
3201		3741
…		…
3203	glLoadIdentity;	3743	glLoadIdentity;
3204	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3744	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3205	glMatrixMode GL_MODELVIEW;	3745	glMatrixMode GL_MODELVIEW;
3206	glLoadIdentity;	3746	glLoadIdentity;
3207		3747
		3748	{
		3749	package CFClient::UI::Base;
		3750
		3751	($draw_x, $draw_y, $draw_w, $draw_h) =
		3752	(0, 0, $self->{w}, $self->{h});
		3753	}
		3754
3208	$self->_draw;	3755	$self->_draw;
3209	}	3756	}
3210		3757
3211	#############################################################################	3758	#############################################################################
3212		3759

Diff Legend

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