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.257 by root, Tue May 30 02:22:02 2006 UTC vs.
Revision 1.291 by root, Tue Jun 6 02:55:50 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) {
…		…
26		55
27	$win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;	56	$win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
28	$win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;	57	$win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
29	$win->{w} = $_->{w} / $::WIDTH if defined $_->{w};	58	$win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
30	$win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};	59	$win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
		60
		61	$win->{show} = $_->{visible} && $_->{is_toplevel};
31	}	62	}
32		63
33	$layout	64	$layout
34	}	65	}
35		66
36	sub set_layout {	67	sub set_layout {
37	my ($layout) = @_;	68	my ($layout) = @_;
		69
38	$LAYOUT = $layout;	70	$LAYOUT = $layout;
39	}
40
41	sub check_tooltip {
42	if (!$GRAB) {
43	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
44	if (length $widget->{tooltip}) {
45
46	if ($TOOLTIP->{owner} != $widget) {
47	$TOOLTIP->hide;
48
49	$TOOLTIP->{owner} = $widget;
50
51	my $tip = $widget->{tooltip};
52
53	$tip = $tip->($widget) if CODE:: eq ref $tip;
54
55	$TOOLTIP->set_tooltip_from ($widget);
56	$TOOLTIP->show;
57	}
58
59	return;
60	}
61	}
62	}
63
64	$TOOLTIP->hide;
65	delete $TOOLTIP->{owner};
66	}	71	}
67		72
68	# class methods for events	73	# class methods for events
69	sub feed_sdl_key_down_event {	74	sub feed_sdl_key_down_event {
70	$FOCUS->emit (key_down => $_[0])	75	$FOCUS->emit (key_down => $_[0])
…		…
84	my $widget = $ROOT->find_widget ($x, $y);	89	my $widget = $ROOT->find_widget ($x, $y);
85		90
86	$GRAB = $widget;	91	$GRAB = $widget;
87	$GRAB->update if $GRAB;	92	$GRAB->update if $GRAB;
88		93
89	check_tooltip;	94	$TOOLTIP_WATCHER->cb->();
90	}	95	}
91		96
92	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
93		98
94	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
…		…
109	if (!$BUTTON_STATE) {	114	if (!$BUTTON_STATE) {
110	my $grab = $GRAB; undef $GRAB;	115	my $grab = $GRAB; undef $GRAB;
111	$grab->update if $grab;	116	$grab->update if $grab;
112	$GRAB->update if $GRAB;	117	$GRAB->update if $GRAB;
113		118
114	check_tooltip;	119	$TOOLTIP_WATCHER->cb->();
115	}	120	}
116	}	121	}
117		122
118	sub feed_sdl_motion_event {	123	sub feed_sdl_motion_event {
119	my ($ev) = @_;	124	my ($ev) = @_;
…		…
125	my $hover = $HOVER; $HOVER = $widget;	130	my $hover = $HOVER; $HOVER = $widget;
126		131
127	$hover->update if $hover && $hover->{can_hover};	132	$hover->update if $hover && $hover->{can_hover};
128	$HOVER->update if $HOVER && $HOVER->{can_hover};	133	$HOVER->update if $HOVER && $HOVER->{can_hover};
129		134
130	check_tooltip;	135	$TOOLTIP_WATCHER->start;
131	}	136	}
132		137
133	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))	138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
134	if $HOVER;	139	if $HOVER;
135	}	140	}
…		…
167	sub rescale_widgets {	172	sub rescale_widgets {
168	my ($sx, $sy) = @_;	173	my ($sx, $sy) = @_;
169		174
170	for my $widget (values %WIDGET) {	175	for my $widget (values %WIDGET) {
171	if ($widget->{is_toplevel}) {	176	if ($widget->{is_toplevel}) {
172	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;	177	$widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
173	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;	178	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
174		179
175	$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.]+$/;
176	$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};
177	$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};
178	$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.]+$/;
179	$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};
180	$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};
181		186
182	$widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;	187	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
183	$widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;	188	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
184		189
185	}	190	}
186	}	191	}
187		192
188	reconfigure_widgets;	193	reconfigure_widgets;
…		…
207	h => undef,	212	h => undef,
208	can_events => 1,	213	can_events => 1,
209	@_	214	@_
210	}, $class;	215	}, $class;
211		216
212	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
213	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{w} if exists $layout->{x};
214	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{h} if exists $layout->{y};
215	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{w} if exists $layout->{w};
216	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{h} if exists $layout->{h};
217
218	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
219	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
220	}
221
222	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);	217	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
223		218
224	for (keys %$self) {	219	for (keys %$self) {
225	if (/^on_(.*)$/) {	220	if (/^on_(.*)$/) {
226	$self->connect ($1 => delete $self->{$_});	221	$self->connect ($1 => delete $self->{$_});
227	}	222	}
228	}	223	}
229		224
		225	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		226	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		227	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		228	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		229	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		230
		231	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		232	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		233
		234	$self->show if $layout->{show};
		235	}
		236
230	$self	237	$self
231	}	238	}
232		239
233	sub destroy {	240	sub destroy {
234	my ($self) = @_;	241	my ($self) = @_;
…		…
271	delete $self->{visible};	278	delete $self->{visible};
272		279
273	undef $GRAB if $GRAB == $self;	280	undef $GRAB if $GRAB == $self;
274	undef $HOVER if $HOVER == $self;	281	undef $HOVER if $HOVER == $self;
275		282
276	CFClient::UI::check_tooltip	283	$CFClient::UI::TOOLTIP_WATCHER->cb->()
277	if $TOOLTIP->{owner} == $self;	284	if $TOOLTIP->{owner} == $self;
278		285
279	$self->focus_out;	286	$self->focus_out;
280		287
281	$self->emit (visibility_change => 0);	288	$self->emit (visibility_change => 0);
…		…
350	$self->{x} = $x;	357	$self->{x} = $x;
351	$self->{y} = $y;	358	$self->{y} = $y;
352	$self->update;	359	$self->update;
353	}	360	}
354		361
355	if ($self->{w} != $w || $self->{h} != $h) {	362	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
356	return unless $self->{visible};	363	return unless $self->{visible};
357		364
		365	$self->{alloc_w} = $w;
		366	$self->{alloc_h} = $h;
		367
358	$self->{root}->{size_alloc}{$self+0} = [$self, $w, $h];	368	$self->{root}{size_alloc}{$self+0} = $self;
359	}	369	}
360	}	370	}
361		371
362	sub size_allocate {	372	sub size_allocate {
363	# nothing to be done	373	# nothing to be done
364	}	374	}
365		375
366	sub children {	376	sub children {
		377	# nop
		378	}
		379
		380	sub visible_children {
		381	$_[0]->children
367	}	382	}
368		383
369	sub set_max_size {	384	sub set_max_size {
370	my ($self, $w, $h) = @_;	385	my ($self, $w, $h) = @_;
371		386
372	delete $self->{max_w}; $self->{max_w} = $w if $w;	387	$self->{max_w} = int $w if defined $w;
373	delete $self->{max_h}; $self->{max_h} = $h if $h;	388	$self->{max_h} = int $h if defined $h;
		389
		390	$self->realloc;
374	}	391	}
375		392
376	sub set_tooltip {	393	sub set_tooltip {
377	my ($self, $tooltip) = @_;	394	my ($self, $tooltip) = @_;
378		395
…		…
383		400
384	$self->{tooltip} = $tooltip;	401	$self->{tooltip} = $tooltip;
385		402
386	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	403	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
387	delete $CFClient::UI::TOOLTIP->{owner};	404	delete $CFClient::UI::TOOLTIP->{owner};
388	CFClient::UI::check_tooltip;	405	$CFClient::UI::TOOLTIP_WATCHER->cb->();
389	}	406	}
390	}	407	}
391		408
392	# translate global coordinates to local coordinate system	409	# translate global coordinates to local coordinate system
393	sub coord2local {	410	sub coord2local {
…		…
430		447
431	$::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
432	unless $FOCUS;	449	unless $FOCUS;
433	}	450	}
434		451
435	sub mouse_motion { }	452	sub mouse_motion { 0 }
436	sub button_up { }	453	sub button_up { 0 }
437	sub key_down { }	454	sub key_down { 0 }
438	sub key_up { }	455	sub key_up { 0 }
439		456
440	sub button_down {	457	sub button_down {
441	my ($self, $ev, $x, $y) = @_;	458	my ($self, $ev, $x, $y) = @_;
442		459
443	$self->focus_in;	460	$self->focus_in;
444	}
445		461
446	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	462	0
447	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	463	}
448	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
449	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
450	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
451		464
452	sub find_widget {	465	sub find_widget {
453	my ($self, $x, $y) = @_;	466	my ($self, $x, $y) = @_;
454		467
455	return () unless $self->{can_events};	468	return () unless $self->{can_events};
…		…
463		476
464	sub set_parent {	477	sub set_parent {
465	my ($self, $parent) = @_;	478	my ($self, $parent) = @_;
466		479
467	Scalar::Util::weaken ($self->{parent} = $parent);	480	Scalar::Util::weaken ($self->{parent} = $parent);
468
469	$self->set_visible if $parent->{visible};	481	$self->set_visible if $parent->{visible};
470	}	482	}
471		483
472	sub connect {	484	sub connect {
473	my ($self, $signal, $cb) = @_;	485	my ($self, $signal, $cb) = @_;
…		…
494		506
495	sub realloc {	507	sub realloc {
496	my ($self) = @_;	508	my ($self) = @_;
497		509
498	if ($self->{visible}) {	510	if ($self->{visible}) {
499	return if $self->{root}{realloc}{$self};	511	return if $self->{root}{realloc}{$self+0};
500		512
501	$self->{root}{realloc}{$self} = $self;	513	$self->{root}{realloc}{$self+0} = $self;
502	$self->{root}->update;	514	$self->{root}->update;
503	} else {	515	} else {
504	delete $self->{req_w};	516	delete $self->{req_w};
		517	delete $self->{req_h};
505	}	518	}
506	}	519	}
507		520
508	sub update {	521	sub update {
509	my ($self) = @_;	522	my ($self) = @_;
…		…
517		530
518	$self->realloc;	531	$self->realloc;
519	$self->update;	532	$self->update;
520	}	533	}
521		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
522	sub draw {	539	sub draw {
523	my ($self) = @_;	540	my ($self) = @_;
524		541
525	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);
526		553
527	glPushMatrix;	554	glPushMatrix;
528	glTranslate $self->{x}, $self->{y}, 0;	555	glTranslate $self->{x}, $self->{y}, 0;
529	$self->_draw;
530	glPopMatrix;
531		556
532	if ($self == $HOVER && $self->{can_hover}) {	557	if ($self == $HOVER && $self->{can_hover}) {
533	my ($x, $y) = @$self{qw(x y)};
534
535	glColor 1, 0.8, 0.5, 0.2;	558	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
536	glEnable GL_BLEND;	559	glEnable GL_BLEND;
537	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	560	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
538	glBegin GL_QUADS;	561	glBegin GL_QUADS;
539	glVertex $x , $y;	562	glVertex 0 , 0;
540	glVertex $x + $self->{w}, $y;	563	glVertex $self->{w}, 0;
541	glVertex $x + $self->{w}, $y + $self->{h};	564	glVertex $self->{w}, $self->{h};
542	glVertex $x , $y + $self->{h};	565	glVertex 0 , $self->{h};
543	glEnd;	566	glEnd;
544	glDisable GL_BLEND;	567	glDisable GL_BLEND;
545	}	568	}
546		569
547	if ($ENV{CFPLUS_DEBUG}) {	570	if ($ENV{CFPLUS_DEBUG} & 1) {
548	glPushMatrix;	571	glPushMatrix;
549	glColor 1, 1, 0, 1;	572	glColor 1, 1, 0, 1;
550	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	573	glTranslate 0.375, 0.375;
551	glBegin GL_LINE_LOOP;	574	glBegin GL_LINE_LOOP;
552	glVertex 0 , 0;	575	glVertex 0 , 0;
553	glVertex $self->{w} - 1, 0;	576	glVertex $self->{w} - 1, 0;
554	glVertex $self->{w} - 1, $self->{h} - 1;	577	glVertex $self->{w} - 1, $self->{h} - 1;
555	glVertex 0 , $self->{h} - 1;	578	glVertex 0 , $self->{h} - 1;
556	glEnd;	579	glEnd;
557	glPopMatrix;	580	glPopMatrix;
558	#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;
559	}	582	}
		583
		584	$self->_draw;
		585	glPopMatrix;
560	}	586	}
561		587
562	sub _draw {	588	sub _draw {
563	my ($self) = @_;	589	my ($self) = @_;
564		590
…		…
602		628
603	if ($color && (@$color < 4 || $color->[3])) {	629	if ($color && (@$color < 4 || $color->[3])) {
604	my ($w, $h) = @$self{qw(w h)};	630	my ($w, $h) = @$self{qw(w h)};
605		631
606	glEnable GL_BLEND;	632	glEnable GL_BLEND;
607	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	633	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
608	glColor @$color;	634	glColor_premultiply @$color;
609		635
610	glBegin GL_QUADS;	636	glBegin GL_QUADS;
611	glVertex 0 , 0;	637	glVertex 0 , 0;
612	glVertex 0 , $h;	638	glVertex 0 , $h;
613	glVertex $w, $h;	639	glVertex $w, $h;
…		…
644	our @ISA = CFClient::UI::Base::;	670	our @ISA = CFClient::UI::Base::;
645		671
646	sub new {	672	sub new {
647	my ($class, %arg) = @_;	673	my ($class, %arg) = @_;
648		674
649	my $children = delete $arg{children} || [];	675	my $children = delete $arg{children};
650		676
651	my $self = $class->SUPER::new (	677	my $self = $class->SUPER::new (
652	children => [],	678	children => [],
653	can_events => 0,	679	can_events => 0,
654	%arg,	680	%arg,
655	);	681	);
		682
656	$self->add ($_) for @$children;	683	$self->add (@$children)
		684	if $children;
657		685
658	$self	686	$self
659	}	687	}
660		688
661	sub add {	689	sub add {
…		…
709	$x -= $self->{x};	737	$x -= $self->{x};
710	$y -= $self->{y};	738	$y -= $self->{y};
711		739
712	my $res;	740	my $res;
713		741
714	for (reverse @{ $self->{children} }) {	742	for (reverse $self->visible_children) {
715	$res = $_->find_widget ($x, $y)	743	$res = $_->find_widget ($x, $y)
716	and return $res;	744	and return $res;
717	}	745	}
718		746
719	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	747	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
761	sub size_request {	789	sub size_request {
762	$_[0]{children}[0]->size_request	790	$_[0]{children}[0]->size_request
763	}	791	}
764		792
765	sub size_allocate {	793	sub size_allocate {
766	my ($self, $w, $h, $changed) = @_;	794	my ($self, $w, $h) = @_;
767		795
768	$self->{children}[0]->configure (0, 0, $w, $h);	796	$self->{children}[0]->configure (0, 0, $w, $h);
769	}	797	}
770		798
771	#############################################################################	799	#############################################################################
		800
		801	# back-buffered drawing area
772		802
773	package CFClient::UI::Window;	803	package CFClient::UI::Window;
774		804
775	our @ISA = CFClient::UI::Bin::;	805	our @ISA = CFClient::UI::Bin::;
776		806
…		…
788	$ROOT->on_post_alloc ($self => sub { $self->render_child });	818	$ROOT->on_post_alloc ($self => sub { $self->render_child });
789	$self->SUPER::update;	819	$self->SUPER::update;
790	}	820	}
791		821
792	sub size_allocate {	822	sub size_allocate {
793	my ($self, $w, $h, $changed) = @_;	823	my ($self, $w, $h) = @_;
794		824
795	$self->SUPER::size_allocate ($w, $h, $changed);	825	$self->SUPER::size_allocate ($w, $h);
796	$self->update	826	$self->update;
797	if $changed;
798	}	827	}
799		828
800	sub _render {	829	sub _render {
		830	my ($self) = @_;
		831
801	$_[0]{children}[0]->draw;	832	$self->{children}[0]->draw;
802	}	833	}
803		834
804	sub render_child {	835	sub render_child {
805	my ($self) = @_;	836	my ($self) = @_;
806		837
807	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	838	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
808	glClearColor 0, 0, 0, 0;	839	glClearColor 0, 0, 0, 0;
809	glClear GL_COLOR_BUFFER_BIT;	840	glClear GL_COLOR_BUFFER_BIT;
810		841
		842	{
		843	package CFClient::UI::Base;
		844
		845	($draw_x, $draw_y, $draw_w, $draw_h) =
		846	(0, 0, $self->{w}, $self->{h});
		847	}
		848
811	$self->_render;	849	$self->_render;
812	};	850	};
813	}	851	}
814		852
815	sub _draw {	853	sub _draw {
816	my ($self) = @_;	854	my ($self) = @_;
817		855
818	my ($w, $h) = ($self->w, $self->h);	856	my ($w, $h) = @$self{qw(w h)};
819		857
820	my $tex = $self->{texture}	858	my $tex = $self->{texture}
821	or return;	859	or return;
822		860
823	glEnable GL_TEXTURE_2D;	861	glEnable GL_TEXTURE_2D;
824	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	862	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
825	glColor 1, 1, 1, 1;	863	glColor 0, 0, 0, 1;
826		864
827	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	865	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
828		866
829	glDisable GL_TEXTURE_2D;	867	glDisable GL_TEXTURE_2D;
830	}	868	}
…		…
846	}	884	}
847		885
848	sub size_request {	886	sub size_request {
849	my ($self) = @_;	887	my ($self) = @_;
850		888
851	my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	889	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
852		890
853	$w = 10 if $self->{scroll_x};	891	$w = 10 if $self->{scroll_x};
854	$h = 10 if $self->{scroll_y};	892	$h = 10 if $self->{scroll_y};
855		893
856	($w, $h)	894	($w, $h)
857	}	895	}
858		896
859	sub size_allocate {	897	sub size_allocate {
860	my ($self, $w, $h, $changed) = @_;	898	my ($self, $w, $h) = @_;
861		899
		900	my $child = $self->child;
		901
862	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	902	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
863	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	903	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
864		904
865	$self->child->configure (0, 0, $w, $h);	905	$self->child->configure (0, 0, $w, $h);
866	$self->update;	906	$self->update;
867	}	907	}
868		908
…		…
904	}	944	}
905		945
906	sub _render {	946	sub _render {
907	my ($self) = @_;	947	my ($self) = @_;
908		948
		949	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		950	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		951
909	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	952	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
910		953
911	$self->SUPER::_render;	954	$self->SUPER::_render;
912	}	955	}
913		956
…		…
916	package CFClient::UI::ScrolledWindow;	959	package CFClient::UI::ScrolledWindow;
917		960
918	our @ISA = CFClient::UI::HBox::;	961	our @ISA = CFClient::UI::HBox::;
919		962
920	sub new {	963	sub new {
921	my $class = shift;	964	my ($class, %arg) = @_;
		965
		966	my $child = delete $arg{child};
922		967
923	my $self;	968	my $self;
924		969
925	my $slider = new CFClient::UI::Slider	970	my $slider = new CFClient::UI::Slider
926	vertical => 1,	971	vertical => 1,
…		…
931	;	976	;
932		977
933	$self = $class->SUPER::new (	978	$self = $class->SUPER::new (
934	vp => (new CFClient::UI::ViewPort expand => 1),	979	vp => (new CFClient::UI::ViewPort expand => 1),
935	slider => $slider,	980	slider => $slider,
936	@_,	981	%arg,
937	);	982	);
938		983
939	$self->{vp}->add ($self->{scrolled});
940	$self->add ($self->{vp});
941	$self->add ($self->{slider});	984	$self->SUPER::add ($self->{vp}, $self->{slider});
		985	$self->add ($child) if $child;
942		986
943	$self	987	$self
		988	}
		989
		990	sub add {
		991	my ($self, $widget) = @_;
		992
		993	$self->{vp}->add ($self->{child} = $widget);
944	}	994	}
945		995
946	sub update {	996	sub update {
947	my ($self) = @_;	997	my ($self) = @_;
948		998
…		…
952	my $child = $self->{vp}->child;	1002	my $child = $self->{vp}->child;
953	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1003	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
954	}	1004	}
955		1005
956	sub size_allocate {	1006	sub size_allocate {
957	my ($self, $w, $h, $changed) = @_;	1007	my ($self, $w, $h) = @_;
958		1008
959	$self->SUPER::size_allocate ($w, $h, $changed);	1009	$self->SUPER::size_allocate ($w, $h);
960		1010
961	my $child = $self->{vp}->child;	1011	my $child = $self->{vp}->child;
962	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1012	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
963	}	1013	}
964		1014
…		…
987		1037
988	if ($self->{bg}) {	1038	if ($self->{bg}) {
989	my ($w, $h) = @$self{qw(w h)};	1039	my ($w, $h) = @$self{qw(w h)};
990		1040
991	glEnable GL_BLEND;	1041	glEnable GL_BLEND;
992	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1042	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
993	glColor @{ $self->{bg} };	1043	glColor_premultiply @{ $self->{bg} };
994		1044
995	glBegin GL_QUADS;	1045	glBegin GL_QUADS;
996	glVertex 0 , 0;	1046	glVertex 0 , 0;
997	glVertex 0 , $h;	1047	glVertex 0 , $h;
998	glVertex $w, $h;	1048	glVertex $w, $h;
…		…
1020	my @border =	1070	my @border =
1021	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1071	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1022	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1072	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1023		1073
1024	sub new {	1074	sub new {
1025	my $class = shift;	1075	my ($class, %arg) = @_;
		1076
		1077	my $title = delete $arg{title};
1026		1078
1027	my $self = $class->SUPER::new (	1079	my $self = $class->SUPER::new (
1028	bg => [1, 1, 1, 1],	1080	bg => [1, 1, 1, 1],
1029	border_bg => [1, 1, 1, 1],	1081	border_bg => [1, 1, 1, 1],
1030	border => 0.6,	1082	border => 0.6,
1031	can_events => 1,	1083	can_events => 1,
1032	@_	1084	min_w => 16,
		1085	min_h => 16,
		1086	%arg,
1033	);	1087	);
1034		1088
1035	$self->{title} &&= new CFClient::UI::Label	1089	$self->{title} = new CFClient::UI::Label
1036	align => 0,	1090	align => 0,
1037	valign => 1,	1091	valign => 1,
1038	text => $self->{title},	1092	text => $title,
1039	fontsize => $self->{border};	1093	fontsize => $self->{border}
		1094	if defined $title;
1040		1095
1041	$self	1096	$self
		1097	}
		1098
		1099	sub add {
		1100	my ($self, @widgets) = @_;
		1101
		1102	$self->SUPER::add (@widgets);
		1103	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
1042	}	1104	}
1043		1105
1044	sub border {	1106	sub border {
1045	int $_[0]{border} * $::FONTSIZE	1107	int $_[0]{border} * $::FONTSIZE
1046	}	1108	}
1047		1109
1048	sub size_request {	1110	sub size_request {
1049	my ($self) = @_;	1111	my ($self) = @_;
		1112
		1113	$self->{title}->size_request
		1114	if $self->{title};
1050		1115
1051	my ($w, $h) = $self->SUPER::size_request;	1116	my ($w, $h) = $self->SUPER::size_request;
1052		1117
1053	(	1118	(
1054	$w + $self->border * 2,	1119	$w + $self->border * 2,
1055	$h + $self->border * 2,	1120	$h + $self->border * 2,
1056	)	1121	)
1057	}	1122	}
1058		1123
1059	sub size_allocate {	1124	sub size_allocate {
1060	my ($self, $w, $h, $changed) = @_;	1125	my ($self, $w, $h) = @_;
1061		1126
1062	return unless $changed;	1127	if ($self->{title}) {
		1128	$self->{title}{w} = $w;
		1129	$self->{title}{h} = $h;
		1130	$self->{title}->size_allocate ($w, $h);
		1131	}
1063		1132
		1133	my $border = $self->border;
		1134
1064	$h -= List::Util::max 0, $self->border * 2;	1135	$h -= List::Util::max 0, $border * 2;
1065	$w -= List::Util::max 0, $self->border * 2;	1136	$w -= List::Util::max 0, $border * 2;
1066		1137
1067	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1068	if $self->{title};
1069
1070	$self->child->configure ($self->border, $self->border, $w, $h);	1138	$self->child->configure ($border, $border, $w, $h);
1071	}	1139	}
1072		1140
1073	sub button_down {	1141	sub button_down {
1074	my ($self, $ev, $x, $y) = @_;	1142	my ($self, $ev, $x, $y) = @_;
1075		1143
…		…
1094	my $dy = $ev->{y} - $oy;	1162	my $dy = $ev->{y} - $oy;
1095		1163
1096	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1164	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1097	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1165	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1098		1166
		1167	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1099	$self->realloc;	1168	$self->realloc;
1100	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1101	};	1169	};
1102		1170
1103	} elsif ($lr ^ $td) {	1171	} elsif ($lr ^ $td) {
1104	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1172	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1105	my ($bx, $by) = ($self->{x}, $self->{y});	1173	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1108	my ($ev, $x, $y) = @_;	1176	my ($ev, $x, $y) = @_;
1109		1177
1110	($x, $y) = ($ev->{x}, $ev->{y});	1178	($x, $y) = ($ev->{x}, $ev->{y});
1111		1179
1112	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1180	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
		1181	# HACK: the next line is required to enforce placement
		1182	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});
1113	};	1183	};
		1184	} else {
		1185	return 0;
		1186	}
		1187
1114	}	1188	1
1115	}	1189	}
1116		1190
1117	sub button_up {	1191	sub button_up {
1118	my ($self, $ev, $x, $y) = @_;	1192	my ($self, $ev, $x, $y) = @_;
1119		1193
1120	delete $self->{motion};	1194	!!delete $self->{motion}
1121	}	1195	}
1122		1196
1123	sub mouse_motion {	1197	sub mouse_motion {
1124	my ($self, $ev, $x, $y) = @_;	1198	my ($self, $ev, $x, $y) = @_;
1125		1199
1126	$self->{motion}->($ev, $x, $y) if $self->{motion};	1200	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1201
		1202	!!$self->{motion}
1127	}	1203	}
1128		1204
1129	sub _draw {	1205	sub _draw {
1130	my ($self) = @_;	1206	my ($self) = @_;
1131		1207
		1208	my $child = $self->{children}[0];
		1209
1132	my ($w, $h ) = ($self->{w}, $self->{h});	1210	my ($w, $h ) = ($self->{w}, $self->{h});
1133	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1211	my ($cw, $ch) = ($child->{w}, $child->{h});
1134		1212
1135	glEnable GL_TEXTURE_2D;	1213	glEnable GL_TEXTURE_2D;
1136	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1214	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1137		1215
1138	my $border = $self->border;	1216	my $border = $self->border;
…		…
1153	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1231	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1154	}	1232	}
1155		1233
1156	glDisable GL_TEXTURE_2D;	1234	glDisable GL_TEXTURE_2D;
1157		1235
1158	$self->{title}->draw if $self->{title};
1159
1160	$self->child->draw;	1236	$child->draw;
		1237
		1238	if ($self->{title}) {
		1239	glTranslate 0, $border - $self->{h};
		1240	$self->{title}->_draw;
		1241	}
1161	}	1242	}
1162		1243
1163	#############################################################################	1244	#############################################################################
1164		1245
1165	package CFClient::UI::Table;	1246	package CFClient::UI::Table;
…		…
1239	(sum @$hs),	1320	(sum @$hs),
1240	)	1321	)
1241	}	1322	}
1242		1323
1243	sub size_allocate {	1324	sub size_allocate {
1244	my ($self, $w, $h, $changed) = @_;	1325	my ($self, $w, $h) = @_;
1245		1326
1246	my ($ws, $hs) = $self->get_wh;	1327	my ($ws, $hs) = $self->get_wh;
1247		1328
1248	my $req_w = (sum @$ws) || 1;	1329	my $req_w = (sum @$ws) || 1;
1249	my $req_h = (sum @$hs) || 1;	1330	my $req_h = (sum @$hs) || 1;
…		…
1327	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1408	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1328	)	1409	)
1329	}	1410	}
1330		1411
1331	sub size_allocate {	1412	sub size_allocate {
1332	my ($self, $w, $h, $changed) = @_;	1413	my ($self, $w, $h) = @_;
1333		1414
1334	my $space = $self->{vertical} ? $h : $w;	1415	my $space = $self->{vertical} ? $h : $w;
1335	my $children = $self->{children};	1416	my $children = $self->{children};
1336		1417
1337	my @req;	1418	my @req;
…		…
1420	ellipsise => 3, # end	1501	ellipsise => 3, # end
1421	layout => (new CFClient::Layout),	1502	layout => (new CFClient::Layout),
1422	fontsize => 1,	1503	fontsize => 1,
1423	align => -1,	1504	align => -1,
1424	valign => -1,	1505	valign => -1,
1425	padding => 2,	1506	padding_x => 2,
		1507	padding_y => 2,
1426	can_events => 0,	1508	can_events => 0,
1427	%arg	1509	%arg
1428	);	1510	);
1429		1511
1430	if (exists $self->{template}) {	1512	if (exists $self->{template}) {
…		…
1457		1539
1458	delete $self->{texture};	1540	delete $self->{texture};
1459	$self->SUPER::update;	1541	$self->SUPER::update;
1460	}	1542	}
1461		1543
		1544	sub realloc {
		1545	my ($self) = @_;
		1546
		1547	delete $self->{ox};
		1548	$self->SUPER::realloc;
		1549	}
		1550
1462	sub set_text {	1551	sub set_text {
1463	my ($self, $text) = @_;	1552	my ($self, $text) = @_;
1464		1553
1465	return if $self->{text} eq "T$text";	1554	return if $self->{text} eq "T$text";
1466	$self->{text} = "T$text";	1555	$self->{text} = "T$text";
1467		1556
1468	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1557	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1469	$self->{layout}->set_text ($text);	1558	$self->{layout}->set_text ($text);
1470		1559
		1560	delete $self->{size_req};
1471	$self->realloc;	1561	$self->realloc;
1472	$self->update;	1562	$self->update;
1473	}	1563	}
1474		1564
1475	sub set_markup {	1565	sub set_markup {
…		…
1481	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1571	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1482		1572
1483	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1573	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1484	$self->{layout}->set_markup ($markup);	1574	$self->{layout}->set_markup ($markup);
1485		1575
		1576	delete $self->{size_req};
1486	$self->realloc;	1577	$self->realloc;
1487	$self->update;	1578	$self->update;
1488	}	1579	}
1489		1580
1490	sub size_request {	1581	sub size_request {
1491	my ($self) = @_;	1582	my ($self) = @_;
1492		1583
		1584	$self->{size_req} ||= do {
1493	$self->{layout}->set_font ($self->{font}) if $self->{font};	1585	$self->{layout}->set_font ($self->{font}) if $self->{font};
1494	$self->{layout}->set_width ($self->{max_w} || -1);	1586	$self->{layout}->set_width ($self->{max_w} || -1);
1495	$self->{layout}->set_ellipsise ($self->{ellipsise});	1587	$self->{layout}->set_ellipsise ($self->{ellipsise});
1496	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1588	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1497	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1589	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1498		1590
1499	my ($w, $h) = $self->{layout}->size;	1591	my ($w, $h) = $self->{layout}->size;
1500		1592
1501	if (exists $self->{template}) {	1593	if (exists $self->{template}) {
1502	$self->{template}->set_font ($self->{font}) if $self->{font};	1594	$self->{template}->set_font ($self->{font}) if $self->{font};
1503	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1595	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1504		1596
1505	my ($w2, $h2) = $self->{template}->size;	1597	my ($w2, $h2) = $self->{template}->size;
1506		1598
1507	$w = List::Util::max $w, $w2;	1599	$w = List::Util::max $w, $w2;
1508	$h = List::Util::max $h, $h2;	1600	$h = List::Util::max $h, $h2;
		1601	}
		1602
		1603	[$w, $h]
1509	}	1604	};
1510		1605
1511	(	1606	@{ $self->{size_req} }
1512	$w + $self->{padding} * 2,
1513	$h + $self->{padding} * 2,
1514	)
1515	}	1607	}
1516		1608
1517	sub size_allocate {	1609	sub size_allocate {
1518	my ($self, $w, $h, $changed) = @_;	1610	my ($self, $w, $h) = @_;
		1611
		1612	delete $self->{ox};
1519		1613
1520	delete $self->{texture}	1614	delete $self->{texture}
1521	if $changed;	1615	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1522	}	1616	}
1523		1617
1524	sub set_fontsize {	1618	sub set_fontsize {
1525	my ($self, $fontsize) = @_;	1619	my ($self, $fontsize) = @_;
1526		1620
1527	$self->{fontsize} = $fontsize;	1621	$self->{fontsize} = $fontsize;
1528	delete $self->{texture};	1622	delete $self->{texture};
1529		1623
1530	$self->realloc;	1624	$self->realloc;
		1625	}
		1626
		1627	sub reconfigure {
		1628	my ($self) = @_;
		1629
		1630	delete $self->{size_req};
		1631
		1632	$self->SUPER::reconfigure;
1531	}	1633	}
1532		1634
1533	sub _draw {	1635	sub _draw {
1534	my ($self) = @_;	1636	my ($self) = @_;
1535		1637
…		…
1541	$self->{layout}->set_width ($self->{w});	1643	$self->{layout}->set_width ($self->{w});
1542	$self->{layout}->set_ellipsise ($self->{ellipsise});	1644	$self->{layout}->set_ellipsise ($self->{ellipsise});
1543	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1645	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1544	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1646	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1545		1647
1546	my $tex = new_from_layout CFClient::Texture $self->{layout};	1648	new_from_layout CFClient::Texture $self->{layout}
		1649	};
1547		1650
		1651	unless (exists $self->{ox}) {
1548	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1652	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1549	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1653	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1550	: ($self->{w} - $tex->{w}) * 0.5);	1654	: ($self->{w} - $tex->{w}) * 0.5);
1551		1655
1552	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1656	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1553	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1657	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1554	: ($self->{h} - $tex->{h}) * 0.5);	1658	: ($self->{h} - $tex->{h}) * 0.5);
1555
1556	$tex
1557	};	1659	};
1558		1660
1559	glEnable GL_TEXTURE_2D;	1661	glEnable GL_TEXTURE_2D;
1560	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1561		1662
1562	if ($tex->{format} == GL_ALPHA) {	1663	if ($tex->{format} == GL_ALPHA) {
		1664	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1563	glColor @{$self->{fg}};	1665	glColor @{$self->{fg}};
1564	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1666	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1565	} else {	1667	} else {
		1668	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1566	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1669	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1567	}	1670	}
1568		1671
1569	glDisable GL_TEXTURE_2D;	1672	glDisable GL_TEXTURE_2D;
1570	}	1673	}
…		…
1588	can_hover => 1,	1691	can_hover => 1,
1589	can_focus => 1,	1692	can_focus => 1,
1590	valign => 0,	1693	valign => 0,
1591	can_events => 1,	1694	can_events => 1,
1592	#text => ...	1695	#text => ...
		1696	#hidden => "*",
1593	@_	1697	@_
1594	)	1698	)
1595	}	1699	}
1596		1700
1597	sub _set_text {	1701	sub _set_text {
…		…
1599		1703
1600	delete $self->{cur_h};	1704	delete $self->{cur_h};
1601		1705
1602	return if $self->{text} eq $text;	1706	return if $self->{text} eq $text;
1603		1707
1604	delete $self->{texture};
1605
1606	$self->{last_activity} = $::NOW;	1708	$self->{last_activity} = $::NOW;
1607	$self->{text} = $text;	1709	$self->{text} = $text;
1608		1710
1609	$text =~ s/./*/g if $self->{hidden};	1711	$text =~ s/./*/g if $self->{hidden};
1610	$self->{layout}->set_text ("$text ");	1712	$self->{layout}->set_text ("$text ");
		1713	delete $self->{size_req};
1611		1714
1612	$self->_emit (changed => $self->{text});	1715	$self->_emit (changed => $self->{text});
		1716
		1717	$self->realloc;
		1718	$self->update;
1613	}	1719	}
1614		1720
1615	sub set_text {	1721	sub set_text {
1616	my ($self, $text) = @_;	1722	my ($self, $text) = @_;
1617		1723
1618	$self->{cursor} = length $text;	1724	$self->{cursor} = length $text;
1619	$self->_set_text ($text);	1725	$self->_set_text ($text);
1620
1621	$self->realloc;
1622	}	1726	}
1623		1727
1624	sub get_text {	1728	sub get_text {
1625	$_[0]{text}	1729	$_[0]{text}
1626	}	1730	}
…		…
1656	$self->{cursor} = length $text;	1760	$self->{cursor} = length $text;
1657	} elsif ($uni == 27) {	1761	} elsif ($uni == 27) {
1658	$self->_emit ('escape');	1762	$self->_emit ('escape');
1659	} elsif ($uni) {	1763	} elsif ($uni) {
1660	substr $text, $self->{cursor}++, 0, chr $uni;	1764	substr $text, $self->{cursor}++, 0, chr $uni;
		1765	} else {
		1766	return 0;
1661	}	1767	}
1662		1768
1663	$self->_set_text ($text);	1769	$self->_set_text ($text);
1664		1770
1665	$self->realloc;	1771	$self->realloc;
		1772
		1773	1
1666	}	1774	}
1667		1775
1668	sub focus_in {	1776	sub focus_in {
1669	my ($self) = @_;	1777	my ($self) = @_;
1670		1778
…		…
1685	utf8::encode $text;	1793	utf8::encode $text;
1686	$self->{cursor} = length substr $text, 0, $idx;	1794	$self->{cursor} = length substr $text, 0, $idx;
1687		1795
1688	$self->_set_text ($self->{text});	1796	$self->_set_text ($self->{text});
1689	$self->update;	1797	$self->update;
		1798
		1799	1
1690	}	1800	}
1691		1801
1692	sub mouse_motion {	1802	sub mouse_motion {
1693	my ($self, $ev, $x, $y) = @_;	1803	my ($self, $ev, $x, $y) = @_;
1694	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1804	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1805
		1806	0
1695	}	1807	}
1696		1808
1697	sub _draw {	1809	sub _draw {
1698	my ($self) = @_;	1810	my ($self) = @_;
1699		1811
1700	local $self->{fg} = $self->{fg};	1812	local $self->{fg} = $self->{fg};
1701		1813
1702	if ($FOCUS == $self) {	1814	if ($FOCUS == $self) {
1703	glColor @{$self->{active_bg}};	1815	glColor_premultiply @{$self->{active_bg}};
1704	$self->{fg} = $self->{active_fg};	1816	$self->{fg} = $self->{active_fg};
1705	} else {	1817	} else {
1706	glColor @{$self->{bg}};	1818	glColor_premultiply @{$self->{bg}};
1707	}	1819	}
1708		1820
1709	glEnable GL_BLEND;	1821	glEnable GL_BLEND;
1710	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1822	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1711	glBegin GL_QUADS;	1823	glBegin GL_QUADS;
1712	glVertex 0 , 0;	1824	glVertex 0 , 0;
1713	glVertex 0 , $self->{h};	1825	glVertex 0 , $self->{h};
1714	glVertex $self->{w}, $self->{h};	1826	glVertex $self->{w}, $self->{h};
1715	glVertex $self->{w}, 0;	1827	glVertex $self->{w}, 0;
…		…
1776	} else {	1888	} else {
1777	$self->set_text ($self->{history_saveback});	1889	$self->set_text ($self->{history_saveback});
1778	}	1890	}
1779		1891
1780	} else {	1892	} else {
1781	$self->SUPER::key_down ($ev);	1893	return $self->SUPER::key_down ($ev)
		1894	}
		1895
1782	}	1896	1
1783
1784	}	1897	}
1785		1898
1786	#############################################################################	1899	#############################################################################
1787		1900
1788	package CFClient::UI::Button;	1901	package CFClient::UI::Button;
…		…
1797		1910
1798	sub new {	1911	sub new {
1799	my $class = shift;	1912	my $class = shift;
1800		1913
1801	$class->SUPER::new (	1914	$class->SUPER::new (
1802	padding => 4,	1915	padding_x => 4,
		1916	padding_y => 4,
1803	fg => [1, 1, 1],	1917	fg => [1, 1, 1],
1804	active_fg => [0, 0, 1],	1918	active_fg => [0, 0, 1],
1805	can_hover => 1,	1919	can_hover => 1,
1806	align => 0,	1920	align => 0,
1807	valign => 0,	1921	valign => 0,
…		…
1816	my ($self, $ev, $x, $y) = @_;	1930	my ($self, $ev, $x, $y) = @_;
1817		1931
1818	$self->emit ("activate")	1932	$self->emit ("activate")
1819	if $x >= 0 && $x < $self->{w}	1933	if $x >= 0 && $x < $self->{w}
1820	&& $y >= 0 && $y < $self->{h};	1934	&& $y >= 0 && $y < $self->{h};
		1935
		1936	1
1821	}	1937	}
1822		1938
1823	sub _draw {	1939	sub _draw {
1824	my ($self) = @_;	1940	my ($self) = @_;
1825		1941
1826	local $self->{fg} = $self->{fg};	1942	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1827
1828	if ($GRAB == $self) {
1829	$self->{fg} = $self->{active_fg};
1830	}
1831		1943
1832	glEnable GL_TEXTURE_2D;	1944	glEnable GL_TEXTURE_2D;
1833	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1945	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1834	glColor 0, 0, 0, 1;	1946	glColor 0, 0, 0, 1;
1835		1947
…		…
1854		1966
1855	sub new {	1967	sub new {
1856	my $class = shift;	1968	my $class = shift;
1857		1969
1858	$class->SUPER::new (	1970	$class->SUPER::new (
1859	padding => 2,	1971	padding_x => 2,
		1972	padding_y => 2,
1860	fg => [1, 1, 1],	1973	fg => [1, 1, 1],
1861	active_fg => [1, 1, 0],	1974	active_fg => [1, 1, 0],
1862	bg => [0, 0, 0, 0.2],	1975	bg => [0, 0, 0, 0.2],
1863	active_bg => [1, 1, 1, 0.5],	1976	active_bg => [1, 1, 1, 0.5],
1864	state => 0,	1977	state => 0,
…		…
1868	}	1981	}
1869		1982
1870	sub size_request {	1983	sub size_request {
1871	my ($self) = @_;	1984	my ($self) = @_;
1872		1985
1873	($self->{padding} * 2 + 6) x 2	1986	(6) x 2
1874	}	1987	}
1875		1988
1876	sub button_down {	1989	sub button_down {
1877	my ($self, $ev, $x, $y) = @_;	1990	my ($self, $ev, $x, $y) = @_;
1878		1991
1879	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1992	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1880	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1993	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1881	$self->{state} = !$self->{state};	1994	$self->{state} = !$self->{state};
1882	$self->_emit (changed => $self->{state});	1995	$self->_emit (changed => $self->{state});
		1996	} else {
		1997	return 0
		1998	}
		1999
1883	}	2000	1
1884	}	2001	}
1885		2002
1886	sub _draw {	2003	sub _draw {
1887	my ($self) = @_;	2004	my ($self) = @_;
1888		2005
1889	$self->SUPER::_draw;	2006	$self->SUPER::_draw;
1890		2007
1891	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	2008	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1892		2009
1893	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	2010	my ($w, $h) = @$self{qw(w h)};
		2011
		2012	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1894		2013
1895	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2014	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1896		2015
1897	my $tex = $self->{state} ? $tex[1] : $tex[0];	2016	my $tex = $self->{state} ? $tex[1] : $tex[0];
1898		2017
…		…
2053		2172
2054	my $h1 = $self->{h} * (1 - $ycut1);	2173	my $h1 = $self->{h} * (1 - $ycut1);
2055	my $h2 = $self->{h} * (1 - $ycut2);	2174	my $h2 = $self->{h} * (1 - $ycut2);
2056		2175
2057	glEnable GL_BLEND;	2176	glEnable GL_BLEND;
2058	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2177	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2178	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2059	glEnable GL_TEXTURE_2D;	2179	glEnable GL_TEXTURE_2D;
2060	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2180	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2061		2181
2062	glBindTexture GL_TEXTURE_2D, $t1->{name};	2182	glBindTexture GL_TEXTURE_2D, $t1->{name};
2063	glBegin GL_QUADS;	2183	glBegin GL_QUADS;
…		…
2224		2344
2225	$self->SUPER::button_down ($ev, $x, $y);	2345	$self->SUPER::button_down ($ev, $x, $y);
2226		2346
2227	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2347	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2228		2348
2229	$self->mouse_motion ($ev, $x, $y);	2349	$self->mouse_motion ($ev, $x, $y)
2230	}	2350	}
2231		2351
2232	sub mouse_motion {	2352	sub mouse_motion {
2233	my ($self, $ev, $x, $y) = @_;	2353	my ($self, $ev, $x, $y) = @_;
2234		2354
…		…
2238	my (undef, $lo, $hi, $page) = @{$self->{range}};	2358	my (undef, $lo, $hi, $page) = @{$self->{range}};
2239		2359
2240	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2360	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2241		2361
2242	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2362	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2363	} else {
		2364	return 0;
		2365	}
		2366
2243	}	2367	1
2244	}	2368	}
2245		2369
2246	sub update {	2370	sub update {
2247	my ($self) = @_;	2371	my ($self) = @_;
2248		2372
2249	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2373	delete $self->{knob_w};
		2374	$self->SUPER::update;
		2375	}
		2376
		2377	sub _draw {
		2378	my ($self) = @_;
		2379
		2380	unless ($self->{knob_w}) {
2250	$self->set_value ($self->{range}[0]);	2381	$self->set_value ($self->{range}[0]);
2251		2382
2252	my ($value, $lo, $hi, $page) = @{$self->{range}};	2383	my ($value, $lo, $hi, $page) = @{$self->{range}};
2253	my $range = ($hi - $page - $lo) || 1e-100;	2384	my $range = ($hi - $page - $lo) || 1e-100;
2254		2385
…		…
2260	$value = ($value - $lo) / $range;	2391	$value = ($value - $lo) / $range;
2261	$value = $value * $self->{scale} + $self->{offset};	2392	$value = $value * $self->{scale} + $self->{offset};
2262		2393
2263	$self->{knob_x} = $value - $knob_w * 0.5;	2394	$self->{knob_x} = $value - $knob_w * 0.5;
2264	$self->{knob_w} = $knob_w;	2395	$self->{knob_w} = $knob_w;
2265	});	2396	}
2266
2267	$self->SUPER::update;
2268	}
2269
2270	sub _draw {
2271	my ($self) = @_;
2272		2397
2273	$self->SUPER::_draw ();	2398	$self->SUPER::_draw ();
2274		2399
2275	glScale $self->{w}, $self->{h};	2400	glScale $self->{w}, $self->{h};
2276		2401
…		…
2374	$self->{fontsize} = $fontsize;	2499	$self->{fontsize} = $fontsize;
2375	$self->reflow;	2500	$self->reflow;
2376	}	2501	}
2377		2502
2378	sub size_allocate {	2503	sub size_allocate {
2379	my ($self, $w, $h, $changed) = @_;	2504	my ($self, $w, $h) = @_;
2380		2505
2381	$self->SUPER::size_allocate ($w, $h, $changed);	2506	$self->SUPER::size_allocate ($w, $h);
2382
2383	return unless $changed;
2384		2507
2385	$self->{layout}->set_font ($self->{font}) if $self->{font};	2508	$self->{layout}->set_font ($self->{font}) if $self->{font};
2386	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2509	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2387	$self->{layout}->set_width ($self->{children}[0]{w});	2510	$self->{layout}->set_width ($self->{children}[0]{w});
2388		2511
…		…
2472		2595
2473	delete $self->{texture};	2596	delete $self->{texture};
2474	}	2597	}
2475		2598
2476	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2599	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2477	glClearColor 0.5, 0.5, 0.5, 0;	2600	glClearColor 0, 0, 0, 0;
2478	glClear GL_COLOR_BUFFER_BIT;	2601	glClear GL_COLOR_BUFFER_BIT;
2479		2602
2480	my $top = int $self->{children}[1]{range}[0];	2603	my $top = int $self->{children}[1]{range}[0];
2481		2604
2482	my $y0 = $top;	2605	my $y0 = $top;
…		…
2517	sub _draw {	2640	sub _draw {
2518	my ($self) = @_;	2641	my ($self) = @_;
2519		2642
2520	glEnable GL_TEXTURE_2D;	2643	glEnable GL_TEXTURE_2D;
2521	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2644	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2522	glColor 1, 1, 1, 1;	2645	glColor 0, 0, 0, 1;
2523	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2646	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2524	glDisable GL_TEXTURE_2D;	2647	glDisable GL_TEXTURE_2D;
2525		2648
2526	$self->{children}[1]->draw;	2649	$self->{children}[1]->draw;
2527		2650
2528	}	2651	}
…		…
2611	}	2734	}
2612		2735
2613	sub set_tooltip_from {	2736	sub set_tooltip_from {
2614	my ($self, $widget) = @_;	2737	my ($self, $widget) = @_;
2615		2738
		2739	my $tooltip = $widget->{tooltip};
		2740
		2741	if ($ENV{CFPLUS_DEBUG} & 2) {
		2742	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2743	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2744	. "req $widget->{req_w} $widget->{req_h}\n"
		2745	. "visible $widget->{visible}";
		2746	}
		2747
2616	$self->add (new CFClient::UI::Label	2748	$self->add (new CFClient::UI::Label
2617	markup => $widget->{tooltip},	2749	markup => $tooltip,
2618	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2750	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2619	fontsize => 0.8,	2751	fontsize => 0.8,
2620	fg => [0, 0, 0, 1],	2752	fg => [0, 0, 0, 1],
2621	ellipsise => 0,	2753	ellipsise => 0,
2622	font => ($widget->{tooltip_font} || $::FONT_PROP),	2754	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2630		2762
2631	($w + 4, $h + 4)	2763	($w + 4, $h + 4)
2632	}	2764	}
2633		2765
2634	sub size_allocate {	2766	sub size_allocate {
2635	my ($self, $w, $h, $changed) = @_;	2767	my ($self, $w, $h) = @_;
2636		2768
2637	return unless $changed;
2638
2639	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2769	$self->SUPER::size_allocate ($w - 4, $h - 4);
2640	}	2770	}
2641		2771
2642	sub visibility_change {	2772	sub visibility_change {
2643	my ($self, $visible) = @_;	2773	my ($self, $visible) = @_;
2644		2774
…		…
2748	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2878	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2749		2879
2750	if ($tex) {	2880	if ($tex) {
2751	glEnable GL_TEXTURE_2D;	2881	glEnable GL_TEXTURE_2D;
2752	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2882	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2753	glColor 1, 1, 1, 1;	2883	glColor 0, 0, 0, 1;
2754	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2884	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2755	glDisable GL_TEXTURE_2D;	2885	glDisable GL_TEXTURE_2D;
2756	}	2886	}
2757	}	2887	}
2758		2888
…		…
2765	$self->SUPER::DESTROY;	2895	$self->SUPER::DESTROY;
2766	}	2896	}
2767		2897
2768	#############################################################################	2898	#############################################################################
2769		2899
2770	package CFClient::UI::Inventory;	2900	package CFClient::UI::Buttonbar;
2771		2901
2772	our @ISA = CFClient::UI::ScrolledWindow::;	2902	our @ISA = CFClient::UI::HBox::;
2773		2903
2774	sub new {	2904	# TODO: should actualyl wrap buttons and other goodies.
2775	my $class = shift;
2776
2777	my $self = $class->SUPER::new (
2778	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2779	@_,
2780	);
2781
2782	$self
2783	}
2784
2785	sub set_items {
2786	my ($self, $items) = @_;
2787
2788	$self->{scrolled}->clear;
2789	return unless $items;
2790
2791	my @items = sort {
2792	($a->{type} <=> $b->{type})
2793	or ($a->{name} cmp $b->{name})
2794	} @$items;
2795
2796	$self->{real_items} = \@items;
2797
2798	my $row = 0;
2799	for my $item (@items) {
2800	CFClient::Item::update_widgets $item;
2801
2802	$self->{scrolled}->add (0, $row, $item->{face_widget});
2803	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2804	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2805
2806	$row++;
2807	}
2808	}
2809		2905
2810	#############################################################################	2906	#############################################################################
2811		2907
2812	package CFClient::UI::Menu;	2908	package CFClient::UI::Menu;
2813		2909
…		…
2825	);	2921	);
2826		2922
2827	$self->add ($self->{vbox} = new CFClient::UI::VBox);	2923	$self->add ($self->{vbox} = new CFClient::UI::VBox);
2828		2924
2829	for my $item (@{ $self->{items} }) {	2925	for my $item (@{ $self->{items} }) {
2830	my ($widget, $cb) = @$item;	2926	my ($widget, $cb, $tooltip) = @$item;
2831		2927
2832	# handle various types of items, only text for now	2928	# handle various types of items, only text for now
2833	if (!ref $widget) {	2929	if (!ref $widget) {
2834	$widget = new CFClient::UI::Label	2930	$widget = new CFClient::UI::Label
2835	can_hover => 1,	2931	can_hover => 1,
2836	can_events => 1,	2932	can_events => 1,
2837	text => $widget;	2933	text => $widget,
		2934	tooltip => $tooltip
2838	}	2935	}
2839		2936
2840	$self->{item}{$widget} = $item;	2937	$self->{item}{$widget} = $item;
2841		2938
2842	$self->{vbox}->add ($widget);	2939	$self->{vbox}->add ($widget);
…		…
2854	# maybe save $GRAB? must be careful about events...	2951	# maybe save $GRAB? must be careful about events...
2855	$GRAB = $self;	2952	$GRAB = $self;
2856	$self->{button} = $ev->{button};	2953	$self->{button} = $ev->{button};
2857		2954
2858	$self->show;	2955	$self->show;
2859	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2956	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2860	}	2957	}
2861		2958
2862	sub mouse_motion {	2959	sub mouse_motion {
2863	my ($self, $ev, $x, $y) = @_;	2960	my ($self, $ev, $x, $y) = @_;
2864		2961
2865	# TODO: should use vbox->find_widget or so	2962	# TODO: should use vbox->find_widget or so
2866	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2963	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2867	$self->{hover} = $self->{item}{$HOVER};	2964	$self->{hover} = $self->{item}{$HOVER};
		2965
		2966	0
2868	}	2967	}
2869		2968
2870	sub button_up {	2969	sub button_up {
2871	my ($self, $ev, $x, $y) = @_;	2970	my ($self, $ev, $x, $y) = @_;
2872		2971
…		…
2874	undef $GRAB;	2973	undef $GRAB;
2875	$self->hide;	2974	$self->hide;
2876		2975
2877	$self->_emit ("popdown");	2976	$self->_emit ("popdown");
2878	$self->{hover}[1]->() if $self->{hover};	2977	$self->{hover}[1]->() if $self->{hover};
		2978	} else {
		2979	return 0
		2980	}
		2981
2879	}	2982	1
2880	}	2983	}
2881		2984
2882	#############################################################################	2985	#############################################################################
2883		2986
2884	package CFClient::UI::Statusbox;	2987	package CFClient::UI::Multiplexer;
2885		2988
2886	our @ISA = CFClient::UI::VBox::;	2989	our @ISA = CFClient::UI::Container::;
2887		2990
2888	sub new {	2991	sub new {
2889	my $class = shift;	2992	my $class = shift;
2890		2993
2891	$class->SUPER::new (	2994	my $self = $class->SUPER::new (
		2995	@_,
		2996	);
		2997
		2998	$self->{current} = $self->{children}[0]
		2999	if @{ $self->{children} };
		3000
		3001	$self
		3002	}
		3003
		3004	sub add {
		3005	my ($self, @widgets) = @_;
		3006
		3007	$self->SUPER::add (@widgets);
		3008
		3009	$self->{current} = $self->{children}[0]
		3010	if @{ $self->{children} };
		3011	}
		3012
		3013	sub set_current_page {
		3014	my ($self, $page_or_widget) = @_;
		3015
		3016	my $widget = ref $page_or_widget
		3017	? $page_or_widget
		3018	: $self->{children}[$page_or_widget];
		3019
		3020	$self->{current} = $widget;
		3021	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3022
		3023	$self->_emit (page_changed => $self->{current});
		3024
		3025	$self->realloc;
		3026	}
		3027
		3028	sub visible_children {
		3029	$_[0]{current}
		3030	}
		3031
		3032	sub size_request {
		3033	my ($self) = @_;
		3034
		3035	$self->{current}->size_request
		3036	}
		3037
		3038	sub size_allocate {
		3039	my ($self, $w, $h) = @_;
		3040
		3041	$self->{current}->configure (0, 0, $w, $h);
		3042	}
		3043
		3044	sub _draw {
		3045	my ($self) = @_;
		3046
		3047	$self->{current}->draw;
		3048	}
		3049
		3050	#############################################################################
		3051
		3052	package CFClient::UI::Notebook;
		3053
		3054	our @ISA = CFClient::UI::VBox::;
		3055
		3056	sub new {
		3057	my $class = shift;
		3058
		3059	my $self = $class->SUPER::new (
		3060	buttonbar => (new CFClient::UI::Buttonbar),
		3061	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3062	# filter => # will be put between multiplexer and $self
		3063	@_,
		3064	);
		3065
		3066	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3067	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3068
		3069	$self
		3070	}
		3071
		3072	sub add {
		3073	my ($self, $title, $widget, $tooltip) = @_;
		3074
		3075	Scalar::Util::weaken $self;
		3076
		3077	$self->{buttonbar}->add (new CFClient::UI::Button
		3078	markup => $title,
		3079	tooltip => $tooltip,
		3080	on_activate => sub { $self->set_current_page ($widget) },
		3081	);
		3082
		3083	$self->{multiplexer}->add ($widget);
		3084	}
		3085
		3086	sub set_current_page {
		3087	my ($self, $page) = @_;
		3088
		3089	$self->{multiplexer}->set_current_page ($page);
		3090	$self->_emit (page_changed => $self->{multiplexer}{current});
		3091	}
		3092
		3093	#############################################################################
		3094
		3095	package CFClient::UI::Combobox;
		3096
		3097	use utf8;
		3098
		3099	our @ISA = CFClient::UI::Button::;
		3100
		3101	sub new {
		3102	my $class = shift;
		3103
		3104	my $self = $class->SUPER::new (
		3105	options => [], # [title, value, tooltip], ...
		3106	value => undef,
		3107	@_,
		3108	);
		3109
		3110	$self->_set_value ($self->{value});
		3111
		3112	$self
		3113	}
		3114
		3115	sub button_down {
		3116	my ($self, $ev) = @_;
		3117
		3118	my @menu_items;
		3119
		3120	for (@{ $self->{options} }) {
		3121	my ($title, $value, $tooltip) = @$_;
		3122
		3123	push @menu_items, [$tooltip, sub { $self->set_value ($value) }];
		3124	}
		3125
		3126	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3127	}
		3128
		3129	sub _set_value {
		3130	my ($self, $value) = @_;
		3131
		3132	my ($item) = grep $_->[1] eq $value, @{ $self->{options} }
		3133	or return;
		3134
		3135	$self->{value} = $item->[1];
		3136	$self->set_markup ("$item->[0] ⇓");
		3137	$self->set_tooltip ($item->[2]);
		3138	}
		3139
		3140	sub set_value {
		3141	my ($self, $value) = @_;
		3142
		3143	return unless $self->{value} ne $value;
		3144
		3145	$self->_set_value ($value);
		3146	$self->_emit (changed => $value);
		3147	}
		3148
		3149	#############################################################################
		3150
		3151	package CFClient::UI::Statusbox;
		3152
		3153	our @ISA = CFClient::UI::VBox::;
		3154
		3155	sub new {
		3156	my $class = shift;
		3157
		3158	my $self = $class->SUPER::new (
2892	fontsize => 0.8,	3159	fontsize => 0.8,
2893	@_,	3160	@_,
2894	)	3161	);
		3162
		3163	Scalar::Util::weaken (my $this = $self);
		3164
		3165	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3166
		3167	$self
2895	}	3168	}
2896		3169
2897	sub reorder {	3170	sub reorder {
2898	my ($self) = @_;	3171	my ($self) = @_;
2899	my $NOW = time;	3172	my $NOW = Time::HiRes::time;
		3173
		3174	# freeze display when hovering over any label
		3175	return if $CFClient::UI::TOOLTIP->{owner}
		3176	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3177	values %{ $self->{item} };
2900		3178
2901	while (my ($k, $v) = each %{ $self->{item} }) {	3179	while (my ($k, $v) = each %{ $self->{item} }) {
2902	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3180	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2903	}	3181	}
2904		3182
…		…
2907	my @items = sort {	3185	my @items = sort {
2908	$a->{pri} <=> $b->{pri}	3186	$a->{pri} <=> $b->{pri}
2909	or $b->{id} <=> $a->{id}	3187	or $b->{id} <=> $a->{id}
2910	} values %{ $self->{item} };	3188	} values %{ $self->{item} };
2911		3189
		3190	$self->{timer}->interval (1);
		3191
2912	my $count = 10 + 1;	3192	my $count = 10 + 1;
2913	for my $item (@items) {	3193	for my $item (@items) {
2914	last unless --$count;	3194	last unless --$count;
2915		3195
2916	push @widgets, $item->{label} ||= do {	3196	my $label = $item->{label} ||= do {
2917	# TODO: doesn't handle markup well (read as: at all)	3197	# TODO: doesn't handle markup well (read as: at all)
2918	my $short = $item->{count} > 1	3198	my $short = $item->{count} > 1
2919	? "<b>$item->{count} ×</b> $item->{text}"	3199	? "<b>$item->{count} ×</b> $item->{text}"
2920	: $item->{text};	3200	: $item->{text};
2921		3201
…		…
2929	tooltip => $item->{tooltip},	3209	tooltip => $item->{tooltip},
2930	tooltip_font => $::FONT_PROP,	3210	tooltip_font => $::FONT_PROP,
2931	tooltip_width => 0.67,	3211	tooltip_width => 0.67,
2932	fontsize => $item->{fontsize} || $self->{fontsize},	3212	fontsize => $item->{fontsize} || $self->{fontsize},
2933	max_w => $::WIDTH * 0.44,	3213	max_w => $::WIDTH * 0.44,
2934	fg => $item->{fg},	3214	fg => [@{ $item->{fg} }],
2935	can_events => 1,	3215	can_events => 1,
2936	can_hover => 1	3216	can_hover => 1
2937	};	3217	};
		3218
		3219	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3220	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3221	$label->update;
		3222	$label->set_max_size (undef, $label->{req_h} * $diff)
		3223	if $diff < 1;
		3224	$self->{timer}->interval (1/30);
		3225	} else {
		3226	$label->{fg}[3] = $item->{fg}[3] || 1;
		3227	}
		3228
		3229	push @widgets, $label;
2938	}	3230	}
2939		3231
2940	$self->clear;	3232	$self->clear;
2941	$self->SUPER::add (reverse @widgets);	3233	$self->SUPER::add (reverse @widgets);
2942	}	3234	}
…		…
2947	$text =~ s/^\s+//;	3239	$text =~ s/^\s+//;
2948	$text =~ s/\s+$//;	3240	$text =~ s/\s+$//;
2949		3241
2950	return unless $text;	3242	return unless $text;
2951		3243
2952	my $timeout = time + ((delete $arg{timeout}) || 60);	3244	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2953		3245
2954	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3246	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2955		3247
2956	if (my $item = $self->{item}{$group}) {	3248	if (my $item = $self->{item}{$group}) {
2957	if ($item->{text} eq $text) {	3249	if ($item->{text} eq $text) {
…		…
2987		3279
2988	$self->reorder;	3280	$self->reorder;
2989	$self->SUPER::reconfigure;	3281	$self->SUPER::reconfigure;
2990	}	3282	}
2991		3283
		3284	sub DESTROY {
		3285	my ($self) = @_;
		3286
		3287	$self->{timer}->cancel;
		3288
		3289	$self->SUPER::DESTROY;
		3290	}
		3291
2992	#############################################################################	3292	#############################################################################
2993		3293
		3294	package CFClient::UI::Inventory;
		3295
		3296	our @ISA = CFClient::UI::ScrolledWindow::;
		3297
		3298	sub new {
		3299	my $class = shift;
		3300
		3301	my $self = $class->SUPER::new (
		3302	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3303	@_,
		3304	);
		3305
		3306	$self
		3307	}
		3308
		3309	sub set_items {
		3310	my ($self, $items) = @_;
		3311
		3312	$self->{child}->clear;
		3313	return unless $items;
		3314
		3315	my @items = sort {
		3316	($a->{type} <=> $b->{type})
		3317	or ($a->{name} cmp $b->{name})
		3318	} @$items;
		3319
		3320	$self->{real_items} = \@items;
		3321
		3322	my $row = 0;
		3323	for my $item (@items) {
		3324	CFClient::Item::update_widgets $item;
		3325
		3326	$self->{child}->add (0, $row, $item->{face_widget});
		3327	$self->{child}->add (1, $row, $item->{desc_widget});
		3328	$self->{child}->add (2, $row, $item->{weight_widget});
		3329
		3330	$row++;
		3331	}
		3332	}
		3333
		3334	#############################################################################
		3335
		3336	package CFClient::UI::BindEditor;
		3337
		3338	our @ISA = CFClient::UI::FancyFrame::;
		3339
		3340	sub new {
		3341	my $class = shift;
		3342
		3343	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3344
		3345	$self->add (my $vb = new CFClient::UI::VBox);
		3346
		3347
		3348	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3349	text => "start recording",
		3350	tooltip => "Start/Stops recording of actions."
		3351	."All subsequent actions after the recording started will be captured."
		3352	."The actions are displayed after the record was stopped."
		3353	."To bind the action you have to click on the 'Bind' button",
		3354	on_activate => sub {
		3355	unless ($self->{recording}) {
		3356	$self->start;
		3357	} else {
		3358	$self->stop;
		3359	}
		3360	});
		3361
		3362	$vb->add (new CFClient::UI::Label text => "Actions:");
		3363	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3364
		3365	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3366	$vb->add (my $hb = new CFClient::UI::HBox);
		3367	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3368	$hb->add (new CFClient::UI::Button
		3369	text => "bind",
		3370	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3371	on_activate => sub {
		3372	$self->ask_for_bind;
		3373	});
		3374
		3375	$vb->add (my $hb = new CFClient::UI::HBox);
		3376	$hb->add (new CFClient::UI::Button
		3377	text => "ok",
		3378	expand => 1,
		3379	tooltip => "This closes the binding editor and saves the binding",
		3380	on_activate => sub {
		3381	$self->hide;
		3382	$self->commit;
		3383	});
		3384
		3385	$hb->add (new CFClient::UI::Button
		3386	text => "cancel",
		3387	expand => 1,
		3388	tooltip => "This closes the binding editor without saving",
		3389	on_activate => sub {
		3390	$self->hide;
		3391	$self->{binding_cancel}->()
		3392	if $self->{binding_cancel};
		3393	});
		3394
		3395	$self->update_binding_widgets;
		3396
		3397	$self
		3398	}
		3399
		3400	sub commit {
		3401	my ($self) = @_;
		3402	my ($mod, $sym, $cmds) = $self->get_binding;
		3403	if ($sym != 0 && @$cmds > 0) {
		3404	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3405	."'. Don't forget 'Save Config'!");
		3406	$self->{binding_change}->($mod, $sym, $cmds)
		3407	if $self->{binding_change};
		3408	} else {
		3409	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3410	$self->{binding_cancel}->()
		3411	if $self->{binding_cancel};
		3412	}
		3413	}
		3414
		3415	sub start {
		3416	my ($self) = @_;
		3417
		3418	$self->{rec_btn}->set_text ("stop recording");
		3419	$self->{recording} = 1;
		3420	$self->clear_command_list;
		3421	$::CONN->start_record if $::CONN;
		3422	}
		3423
		3424	sub stop {
		3425	my ($self) = @_;
		3426
		3427	$self->{rec_btn}->set_text ("start recording");
		3428	$self->{recording} = 0;
		3429
		3430	my $rec;
		3431	$rec = $::CONN->stop_record if $::CONN;
		3432	return unless ref $rec eq 'ARRAY';
		3433	$self->set_command_list ($rec);
		3434	}
		3435
		3436
		3437	sub ask_for_bind_and_commit {
		3438	my ($self) = @_;
		3439	$self->ask_for_bind (1);
		3440	}
		3441
		3442	sub ask_for_bind {
		3443	my ($self, $commit) = @_;
		3444
		3445	CFClient::Binder::open_binding_dialog (sub {
		3446	my ($mod, $sym) = @_;
		3447	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3448	$self->update_binding_widgets;
		3449	$self->commit if $commit;
		3450	});
		3451	}
		3452
		3453	# $mod and $sym are the modifiers and key symbol
		3454	# $cmds is a array ref of strings (the commands)
		3455	# $cb is the callback that is executed on OK
		3456	# $ccb is the callback that is executed on CANCEL and
		3457	# when the binding was unsuccessful on OK
		3458	sub set_binding {
		3459	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3460
		3461	$self->clear_command_list;
		3462	$self->{recording} = 0;
		3463	$self->{rec_btn}->set_text ("start recording");
		3464
		3465	$self->{binding} = [$mod, $sym];
		3466	$self->{commands} = $cmds;
		3467
		3468	$self->{binding_change} = $cb;
		3469	$self->{binding_cancel} = $ccb;
		3470
		3471	$self->update_binding_widgets;
		3472	}
		3473
		3474	# this is a shortcut method that asks for a binding
		3475	# and then just binds it.
		3476	sub do_quick_binding {
		3477	my ($self, $cmds) = @_;
		3478	$self->set_binding (undef, undef, $cmds, sub {
		3479	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3480	});
		3481	$self->ask_for_bind (1);
		3482	}
		3483
		3484	sub update_binding_widgets {
		3485	my ($self) = @_;
		3486	my ($mod, $sym, $cmds) = $self->get_binding;
		3487	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3488	$self->set_command_list ($cmds);
		3489	}
		3490
		3491	sub get_binding {
		3492	my ($self) = @_;
		3493	return (
		3494	$self->{binding}->[0],
		3495	$self->{binding}->[1],
		3496	[ grep { defined $_ } @{$self->{commands}} ]
		3497	);
		3498	}
		3499
		3500	sub clear_command_list {
		3501	my ($self) = @_;
		3502	$self->{cmdbox}->clear ();
		3503	}
		3504
		3505	sub set_command_list {
		3506	my ($self, $cmds) = @_;
		3507
		3508	$self->{cmdbox}->clear ();
		3509	$self->{commands} = $cmds;
		3510
		3511	my $idx = 0;
		3512
		3513	for (@$cmds) {
		3514	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3515
		3516	my $i = $idx;
		3517	$hb->add (new CFClient::UI::Label text => $_);
		3518	$hb->add (new CFClient::UI::Button
		3519	text => "delete",
		3520	tooltip => "Deletes the action from the record",
		3521	on_activate => sub {
		3522	$self->{cmdbox}->remove ($hb);
		3523	$cmds->[$i] = undef;
		3524	});
		3525
		3526
		3527	$idx++
		3528	}
		3529	}
		3530
		3531	#############################################################################
		3532
		3533	package CFClient::UI::SpellList;
		3534
		3535	our @ISA = CFClient::UI::Table::;
		3536
		3537	sub new {
		3538	my $class = shift;
		3539
		3540	my $self = $class->SUPER::new (
		3541	binding => [],
		3542	commands => [],
		3543	@_,
		3544	)
		3545	}
		3546
		3547	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3548	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.");
		3549	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3550	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.");
		3551	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3552	"<b>Damage</b>. The amount of damage the spell deals when it hits.");
		3553
		3554	sub rebuild_spell_list {
		3555	my ($self) = @_;
		3556
		3557	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3558	$self->clear;
		3559
		3560	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name");
		3561	$self->add (2, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3562	$self->add (3, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3563	$self->add (4, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3564
		3565	my $row = 0;
		3566
		3567	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3568	my $spell = $self->{spell}{$_};
		3569
		3570	$row++;
		3571
		3572	$self->add (0, $row, new CFClient::UI::Face
		3573	face => $spell->{face},
		3574	can_hover => 1,
		3575	can_events => 1,
		3576	tooltip => $spell->{message},
		3577	);
		3578
		3579	$self->add (1, $row, new CFClient::UI::Label
		3580	expand => 1,
		3581	text => $spell->{name},
		3582	can_hover => 1,
		3583	can_events => 1,
		3584	tooltip => $spell->{message},
		3585	);
		3586
		3587	$self->add (2, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3588	$self->add (3, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3589	$self->add (4, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3590
		3591	# TODO: should be done via popup
		3592	$self->add (5, $row, new CFClient::UI::Button
		3593	text => "bind",
		3594	tooltip => "bind spell readying (cast command) to key",
		3595	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) },
		3596	);
		3597	}
		3598	});
		3599	}
		3600
		3601	sub add_spell {
		3602	my ($self, $spell) = @_;
		3603
		3604	$self->{spell}->{$spell->{name}} = $spell;
		3605	$self->rebuild_spell_list;
		3606	}
		3607
		3608	sub remove_spell {
		3609	my ($self, $spell) = @_;
		3610
		3611	delete $self->{spell}->{$spell->{name}};
		3612	$self->rebuild_spell_list;
		3613	}
		3614
		3615	#############################################################################
		3616
2994	package CFClient::UI::Root;	3617	package CFClient::UI::Root;
2995		3618
2996	our @ISA = CFClient::UI::Container::;	3619	our @ISA = CFClient::UI::Container::;
		3620
		3621	use List::Util qw(min max);
2997		3622
2998	use CFClient::OpenGL;	3623	use CFClient::OpenGL;
2999		3624
3000	sub new {	3625	sub new {
3001	my $class = shift;	3626	my $class = shift;
…		…
3008	Scalar::Util::weaken ($self->{root} = $self);	3633	Scalar::Util::weaken ($self->{root} = $self);
3009		3634
3010	$self	3635	$self
3011	}	3636	}
3012		3637
3013	sub configure {
3014	my ($self, $x, $y, $w, $h) = @_;
3015
3016	$self->{w} = $w;
3017	$self->{h} = $h;
3018	}
3019
3020	sub reconfigure {
3021	my ($self) = @_;
3022
3023	$self->SUPER::reconfigure;
3024
3025	$self->size_allocate ($self->{w}, $self->{h}, 1)
3026	if $self->{w};
3027	}
3028
3029	sub size_request {	3638	sub size_request {
3030	my ($self) = @_;	3639	my ($self) = @_;
3031		3640
3032	($self->{w}, $self->{h})	3641	($self->{w}, $self->{h})
3033	}	3642	}
…		…
3045		3654
3046	int $coord + 0.5	3655	int $coord + 0.5
3047	}	3656	}
3048		3657
3049	sub size_allocate {	3658	sub size_allocate {
3050	my ($self, $w, $h, $changed) = @_;	3659	my ($self, $w, $h) = @_;
3051		3660
3052	for my $child ($self->children) {	3661	for my $child ($self->children) {
3053	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3662	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3054		3663
3055	$X = $child->{force_x} if exists $child->{force_x};	3664	$X = $child->{force_x} if exists $child->{force_x};
…		…
3123	$_->()	3732	$_->()
3124	for values %{delete $self->{refresh_hook}};	3733	for values %{delete $self->{refresh_hook}};
3125	}	3734	}
3126		3735
3127	if ($self->{realloc}) {	3736	if ($self->{realloc}) {
		3737	my %queue;
3128	my @queue;	3738	my @queue;
		3739	my $widget;
3129		3740
		3741	outer:
3130	while () {	3742	while () {
3131	if ($self->{realloc}) {	3743	if (my $realloc = delete $self->{realloc}) {
3132	#TODO use array-of-depth approach	3744	for $widget (values %$realloc) {
		3745	$widget->{visible} or next; # do not resize invisible widgets
3133		3746
3134	@queue = sort { $a->{visible} <=> $b->{visible} }	3747	$queue{$widget+0}++ and next; # duplicates are common
3135	@queue, values %{delete $self->{realloc}};	3748
		3749	push @{ $queue[$widget->{visible}] }, $widget;
		3750	}
3136	}	3751	}
3137		3752
		3753	while () {
		3754	@queue or last outer;
		3755
3138	my $widget = pop @queue || last;	3756	$widget = pop @{ $queue[-1] || [] }
		3757	and last;
		3758
		3759	pop @queue;
		3760	}
3139		3761
3140	$widget->{visible} or last; # do not resize invisible widgets	3762	delete $queue{$widget+0};
3141		3763
3142	my ($w, $h) = $widget->size_request;	3764	my ($w, $h) = $widget->size_request;
3143		3765
3144	my $min_size = $widget->{is_toplevel} ? 16 : 0;	3766	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3767	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3145		3768
3146	$w = List::Util::max $widget->{min_w} || $widget->{is_toplevel} * 16, $w;	3769	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
3147	$h = List::Util::max $widget->{min_h} || $widget->{is_toplevel} * 16, $h;	3770	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3148		3771
3149	$w = $widget->{force_w} if exists $widget->{force_w};	3772	$w = $widget->{force_w} if exists $widget->{force_w};
3150	$h = $widget->{force_h} if exists $widget->{force_h};	3773	$h = $widget->{force_h} if exists $widget->{force_h};
3151		3774
		3775	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3776	|| delete $widget->{force_realloc}) {
3152	$widget->{req_w} = $w;	3777	$widget->{req_w} = $w;
3153	$widget->{req_h} = $h;	3778	$widget->{req_h} = $h;
3154		3779
3155	$self->{size_alloc}{$widget} = [$widget, undef, undef];	3780	$self->{size_alloc}{$widget+0} = $widget;
3156		3781
3157	push @queue, $widget->{parent}	3782	if (my $parent = $widget->{parent}) {
3158	if ($self->{w} != $w || $self->{h} != $h) && $widget->{parent};	3783	$self->{realloc}{$parent+0} = $parent
		3784	unless $queue{$parent+0};
		3785
		3786	$parent->{force_size_alloc} = 1;
		3787	$self->{size_alloc}{$parent+0} = $parent;
		3788	}
		3789	}
		3790
		3791	delete $self->{realloc}{$widget+0};
3159	}	3792	}
3160	}	3793	}
3161		3794
3162	while (my $size_alloc = delete $self->{size_alloc}) {	3795	while (my $size_alloc = delete $self->{size_alloc}) {
3163	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3796	my @queue = sort { $b->{visible} <=> $a->{visible} }
3164	values %$size_alloc;	3797	values %$size_alloc;
3165		3798
3166	while () {	3799	while () {
3167	my ($widget, $w, $h) = @{ pop @queue or last };	3800	my $widget = pop @queue || last;
3168		3801
3169	$w = $widget->{w} || $widget->{req_w} unless defined $w;	3802	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3170	$h = $widget->{h} || $widget->{req_h} unless defined $h;
3171		3803
3172	$w = 0 if $w < 0;	3804	$w = 0 if $w < 0;
3173	$h = 0 if $h < 0;	3805	$h = 0 if $h < 0;
3174		3806
3175	$w = int $w + 0.5;	3807	$w = int $w + 0.5;
3176	$h = int $h + 0.5;	3808	$h = int $h + 0.5;
3177		3809
3178	my $changed = $widget->{w} != $w || $widget->{h} != $h;	3810	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3811	$widget->{old_w} = $widget->{w};
		3812	$widget->{old_h} = $widget->{h};
3179		3813
3180	$widget->{w} = $w;	3814	$widget->{w} = $w;
3181	$widget->{h} = $h;	3815	$widget->{h} = $h;
3182		3816
3183	$widget->emit (size_allocate => $w, $h, $changed);	3817	$widget->emit (size_allocate => $w, $h);
		3818	}
3184	}	3819	}
3185	}	3820	}
3186		3821
3187	while ($self->{post_alloc_hook}) {	3822	while ($self->{post_alloc_hook}) {
3188	$_->()	3823	$_->()
3189	for values %{delete $self->{post_alloc_hook}};	3824	for values %{delete $self->{post_alloc_hook}};
3190	}	3825	}
		3826
3191		3827
3192	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3828	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3193	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3829	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3194	glClear GL_COLOR_BUFFER_BIT;	3830	glClear GL_COLOR_BUFFER_BIT;
3195		3831
…		…
3197	glLoadIdentity;	3833	glLoadIdentity;
3198	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3834	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3199	glMatrixMode GL_MODELVIEW;	3835	glMatrixMode GL_MODELVIEW;
3200	glLoadIdentity;	3836	glLoadIdentity;
3201		3837
		3838	{
		3839	package CFClient::UI::Base;
		3840
		3841	($draw_x, $draw_y, $draw_w, $draw_h) =
		3842	(0, 0, $self->{w}, $self->{h});
		3843	}
		3844
3202	$self->_draw;	3845	$self->_draw;
3203	}	3846	}
3204		3847
3205	#############################################################################	3848	#############################################################################
3206		3849

Diff Legend

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