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.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) {
…		…
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) = @_;
…		…
513	}	526	}
514		527
515	sub reconfigure {	528	sub reconfigure {
516	my ($self) = @_;	529	my ($self) = @_;
517		530
		531	# some widgets cache req_w and req_h
		532	delete $self->{req_w};
		533	delete $self->{req_h};
		534
518	$self->realloc;	535	$self->realloc;
519	$self->update;	536	$self->update;
520	}	537	}
521		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
522	sub draw {	543	sub draw {
523	my ($self) = @_;	544	my ($self) = @_;
524		545
525	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);
526		557
527	glPushMatrix;	558	glPushMatrix;
528	glTranslate $self->{x}, $self->{y}, 0;	559	glTranslate $self->{x}, $self->{y}, 0;
529	$self->_draw;
530	glPopMatrix;
531		560
532	if ($self == $HOVER && $self->{can_hover}) {	561	if ($self == $HOVER && $self->{can_hover}) {
533	my ($x, $y) = @$self{qw(x y)};
534
535	glColor 1, 0.8, 0.5, 0.2;	562	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
536	glEnable GL_BLEND;	563	glEnable GL_BLEND;
537	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	564	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
538	glBegin GL_QUADS;	565	glBegin GL_QUADS;
539	glVertex $x , $y;	566	glVertex 0 , 0;
540	glVertex $x + $self->{w}, $y;	567	glVertex $self->{w}, 0;
541	glVertex $x + $self->{w}, $y + $self->{h};	568	glVertex $self->{w}, $self->{h};
542	glVertex $x , $y + $self->{h};	569	glVertex 0 , $self->{h};
543	glEnd;	570	glEnd;
544	glDisable GL_BLEND;	571	glDisable GL_BLEND;
545	}	572	}
546		573
547	if ($ENV{CFPLUS_DEBUG}) {	574	if ($ENV{CFPLUS_DEBUG} & 1) {
548	glPushMatrix;	575	glPushMatrix;
549	glColor 1, 1, 0, 1;	576	glColor 1, 1, 0, 1;
550	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	577	glTranslate 0.375, 0.375;
551	glBegin GL_LINE_LOOP;	578	glBegin GL_LINE_LOOP;
552	glVertex 0 , 0;	579	glVertex 0 , 0;
553	glVertex $self->{w} - 1, 0;	580	glVertex $self->{w} - 1, 0;
554	glVertex $self->{w} - 1, $self->{h} - 1;	581	glVertex $self->{w} - 1, $self->{h} - 1;
555	glVertex 0 , $self->{h} - 1;	582	glVertex 0 , $self->{h} - 1;
556	glEnd;	583	glEnd;
557	glPopMatrix;	584	glPopMatrix;
558	#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;
559	}	586	}
		587
		588	$self->_draw;
		589	glPopMatrix;
560	}	590	}
561		591
562	sub _draw {	592	sub _draw {
563	my ($self) = @_;	593	my ($self) = @_;
564		594
…		…
602		632
603	if ($color && (@$color < 4 || $color->[3])) {	633	if ($color && (@$color < 4 || $color->[3])) {
604	my ($w, $h) = @$self{qw(w h)};	634	my ($w, $h) = @$self{qw(w h)};
605		635
606	glEnable GL_BLEND;	636	glEnable GL_BLEND;
607	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	637	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
608	glColor @$color;	638	glColor_premultiply @$color;
609		639
610	glBegin GL_QUADS;	640	glBegin GL_QUADS;
611	glVertex 0 , 0;	641	glVertex 0 , 0;
612	glVertex 0 , $h;	642	glVertex 0 , $h;
613	glVertex $w, $h;	643	glVertex $w, $h;
…		…
644	our @ISA = CFClient::UI::Base::;	674	our @ISA = CFClient::UI::Base::;
645		675
646	sub new {	676	sub new {
647	my ($class, %arg) = @_;	677	my ($class, %arg) = @_;
648		678
649	my $children = delete $arg{children} || [];	679	my $children = delete $arg{children};
650		680
651	my $self = $class->SUPER::new (	681	my $self = $class->SUPER::new (
652	children => [],	682	children => [],
653	can_events => 0,	683	can_events => 0,
654	%arg,	684	%arg,
655	);	685	);
		686
656	$self->add ($_) for @$children;	687	$self->add (@$children)
		688	if $children;
657		689
658	$self	690	$self
659	}	691	}
660		692
661	sub add {	693	sub add {
…		…
709	$x -= $self->{x};	741	$x -= $self->{x};
710	$y -= $self->{y};	742	$y -= $self->{y};
711		743
712	my $res;	744	my $res;
713		745
714	for (reverse @{ $self->{children} }) {	746	for (reverse $self->visible_children) {
715	$res = $_->find_widget ($x, $y)	747	$res = $_->find_widget ($x, $y)
716	and return $res;	748	and return $res;
717	}	749	}
718		750
719	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	751	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
761	sub size_request {	793	sub size_request {
762	$_[0]{children}[0]->size_request	794	$_[0]{children}[0]->size_request
763	}	795	}
764		796
765	sub size_allocate {	797	sub size_allocate {
766	my ($self, $w, $h, $changed) = @_;	798	my ($self, $w, $h) = @_;
767		799
768	$self->{children}[0]->configure (0, 0, $w, $h);	800	$self->{children}[0]->configure (0, 0, $w, $h);
769	}	801	}
770		802
771	#############################################################################	803	#############################################################################
		804
		805	# back-buffered drawing area
772		806
773	package CFClient::UI::Window;	807	package CFClient::UI::Window;
774		808
775	our @ISA = CFClient::UI::Bin::;	809	our @ISA = CFClient::UI::Bin::;
776		810
…		…
788	$ROOT->on_post_alloc ($self => sub { $self->render_child });	822	$ROOT->on_post_alloc ($self => sub { $self->render_child });
789	$self->SUPER::update;	823	$self->SUPER::update;
790	}	824	}
791		825
792	sub size_allocate {	826	sub size_allocate {
793	my ($self, $w, $h, $changed) = @_;	827	my ($self, $w, $h) = @_;
794		828
795	$self->SUPER::size_allocate ($w, $h, $changed);	829	$self->SUPER::size_allocate ($w, $h);
796	$self->update	830	$self->update;
797	if $changed;
798	}	831	}
799		832
800	sub _render {	833	sub _render {
		834	my ($self) = @_;
		835
801	$_[0]{children}[0]->draw;	836	$self->{children}[0]->draw;
802	}	837	}
803		838
804	sub render_child {	839	sub render_child {
805	my ($self) = @_;	840	my ($self) = @_;
806		841
807	$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 {
808	glClearColor 0, 0, 0, 0;	843	glClearColor 0, 0, 0, 0;
809	glClear GL_COLOR_BUFFER_BIT;	844	glClear GL_COLOR_BUFFER_BIT;
810		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
811	$self->_render;	853	$self->_render;
812	};	854	};
813	}	855	}
814		856
815	sub _draw {	857	sub _draw {
816	my ($self) = @_;	858	my ($self) = @_;
817		859
818	my ($w, $h) = ($self->w, $self->h);	860	my ($w, $h) = @$self{qw(w h)};
819		861
820	my $tex = $self->{texture}	862	my $tex = $self->{texture}
821	or return;	863	or return;
822		864
823	glEnable GL_TEXTURE_2D;	865	glEnable GL_TEXTURE_2D;
824	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	866	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
825	glColor 1, 1, 1, 1;	867	glColor 0, 0, 0, 1;
826		868
827	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	869	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
828		870
829	glDisable GL_TEXTURE_2D;	871	glDisable GL_TEXTURE_2D;
830	}	872	}
…		…
846	}	888	}
847		889
848	sub size_request {	890	sub size_request {
849	my ($self) = @_;	891	my ($self) = @_;
850		892
851	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)};
852		894
853	$w = 10 if $self->{scroll_x};	895	$w = 10 if $self->{scroll_x};
854	$h = 10 if $self->{scroll_y};	896	$h = 10 if $self->{scroll_y};
855		897
856	($w, $h)	898	($w, $h)
857	}	899	}
858		900
859	sub size_allocate {	901	sub size_allocate {
860	my ($self, $w, $h, $changed) = @_;	902	my ($self, $w, $h) = @_;
861		903
		904	my $child = $self->child;
		905
862	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	906	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
863	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	907	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
864		908
865	$self->child->configure (0, 0, $w, $h);	909	$self->child->configure (0, 0, $w, $h);
866	$self->update;	910	$self->update;
867	}	911	}
868		912
…		…
904	}	948	}
905		949
906	sub _render {	950	sub _render {
907	my ($self) = @_;	951	my ($self) = @_;
908		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
909	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	956	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
910		957
911	$self->SUPER::_render;	958	$self->SUPER::_render;
912	}	959	}
913		960
…		…
916	package CFClient::UI::ScrolledWindow;	963	package CFClient::UI::ScrolledWindow;
917		964
918	our @ISA = CFClient::UI::HBox::;	965	our @ISA = CFClient::UI::HBox::;
919		966
920	sub new {	967	sub new {
921	my $class = shift;	968	my ($class, %arg) = @_;
		969
		970	my $child = delete $arg{child};
922		971
923	my $self;	972	my $self;
924		973
925	my $slider = new CFClient::UI::Slider	974	my $slider = new CFClient::UI::Slider
926	vertical => 1,	975	vertical => 1,
…		…
931	;	980	;
932		981
933	$self = $class->SUPER::new (	982	$self = $class->SUPER::new (
934	vp => (new CFClient::UI::ViewPort expand => 1),	983	vp => (new CFClient::UI::ViewPort expand => 1),
935	slider => $slider,	984	slider => $slider,
936	@_,	985	%arg,
937	);	986	);
938		987
939	$self->{vp}->add ($self->{scrolled});
940	$self->add ($self->{vp});
941	$self->add ($self->{slider});	988	$self->SUPER::add ($self->{vp}, $self->{slider});
		989	$self->add ($child) if $child;
942		990
943	$self	991	$self
		992	}
		993
		994	sub add {
		995	my ($self, $widget) = @_;
		996
		997	$self->{vp}->add ($self->{child} = $widget);
944	}	998	}
945		999
946	sub update {	1000	sub update {
947	my ($self) = @_;	1001	my ($self) = @_;
948		1002
…		…
952	my $child = $self->{vp}->child;	1006	my $child = $self->{vp}->child;
953	$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]);
954	}	1008	}
955		1009
956	sub size_allocate {	1010	sub size_allocate {
957	my ($self, $w, $h, $changed) = @_;	1011	my ($self, $w, $h) = @_;
958		1012
959	$self->SUPER::size_allocate ($w, $h, $changed);	1013	$self->SUPER::size_allocate ($w, $h);
960		1014
961	my $child = $self->{vp}->child;	1015	my $child = $self->{vp}->child;
962	$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]);
963	}	1017	}
964		1018
…		…
987		1041
988	if ($self->{bg}) {	1042	if ($self->{bg}) {
989	my ($w, $h) = @$self{qw(w h)};	1043	my ($w, $h) = @$self{qw(w h)};
990		1044
991	glEnable GL_BLEND;	1045	glEnable GL_BLEND;
992	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1046	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
993	glColor @{ $self->{bg} };	1047	glColor_premultiply @{ $self->{bg} };
994		1048
995	glBegin GL_QUADS;	1049	glBegin GL_QUADS;
996	glVertex 0 , 0;	1050	glVertex 0 , 0;
997	glVertex 0 , $h;	1051	glVertex 0 , $h;
998	glVertex $w, $h;	1052	glVertex $w, $h;
…		…
1020	my @border =	1074	my @border =
1021	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1075	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);	1076	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1023		1077
1024	sub new {	1078	sub new {
1025	my $class = shift;	1079	my ($class, %arg) = @_;
		1080
		1081	my $title = delete $arg{title};
1026		1082
1027	my $self = $class->SUPER::new (	1083	my $self = $class->SUPER::new (
1028	bg => [1, 1, 1, 1],	1084	bg => [1, 1, 1, 1],
1029	border_bg => [1, 1, 1, 1],	1085	border_bg => [1, 1, 1, 1],
1030	border => 0.6,	1086	border => 0.6,
1031	can_events => 1,	1087	can_events => 1,
1032	@_	1088	min_w => 16,
		1089	min_h => 16,
		1090	%arg,
1033	);	1091	);
1034		1092
1035	$self->{title} &&= new CFClient::UI::Label	1093	$self->{title} = new CFClient::UI::Label
1036	align => 0,	1094	align => 0,
1037	valign => 1,	1095	valign => 1,
1038	text => $self->{title},	1096	text => $title,
1039	fontsize => $self->{border};	1097	fontsize => $self->{border}
		1098	if defined $title;
1040		1099
1041	$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};
1042	}	1108	}
1043		1109
1044	sub border {	1110	sub border {
1045	int $_[0]{border} * $::FONTSIZE	1111	int $_[0]{border} * $::FONTSIZE
1046	}	1112	}
1047		1113
1048	sub size_request {	1114	sub size_request {
1049	my ($self) = @_;	1115	my ($self) = @_;
		1116
		1117	$self->{title}->size_request
		1118	if $self->{title};
1050		1119
1051	my ($w, $h) = $self->SUPER::size_request;	1120	my ($w, $h) = $self->SUPER::size_request;
1052		1121
1053	(	1122	(
1054	$w + $self->border * 2,	1123	$w + $self->border * 2,
1055	$h + $self->border * 2,	1124	$h + $self->border * 2,
1056	)	1125	)
1057	}	1126	}
1058		1127
1059	sub size_allocate {	1128	sub size_allocate {
1060	my ($self, $w, $h, $changed) = @_;	1129	my ($self, $w, $h) = @_;
1061		1130
1062	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	}
1063		1136
		1137	my $border = $self->border;
		1138
1064	$h -= List::Util::max 0, $self->border * 2;	1139	$h -= List::Util::max 0, $border * 2;
1065	$w -= List::Util::max 0, $self->border * 2;	1140	$w -= List::Util::max 0, $border * 2;
1066		1141
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);	1142	$self->child->configure ($border, $border, $w, $h);
1071	}	1143	}
1072		1144
1073	sub button_down {	1145	sub button_down {
1074	my ($self, $ev, $x, $y) = @_;	1146	my ($self, $ev, $x, $y) = @_;
1075		1147
…		…
1094	my $dy = $ev->{y} - $oy;	1166	my $dy = $ev->{y} - $oy;
1095		1167
1096	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1168	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1097	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1169	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1098		1170
		1171	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1099	$self->realloc;	1172	$self->realloc;
1100	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1101	};	1173	};
1102		1174
1103	} elsif ($lr ^ $td) {	1175	} elsif ($lr ^ $td) {
1104	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1176	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1105	my ($bx, $by) = ($self->{x}, $self->{y});	1177	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1108	my ($ev, $x, $y) = @_;	1180	my ($ev, $x, $y) = @_;
1109		1181
1110	($x, $y) = ($ev->{x}, $ev->{y});	1182	($x, $y) = ($ev->{x}, $ev->{y});
1111		1183
1112	$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});
1113	};	1187	};
		1188	} else {
		1189	return 0;
		1190	}
		1191
1114	}	1192	1
1115	}	1193	}
1116		1194
1117	sub button_up {	1195	sub button_up {
1118	my ($self, $ev, $x, $y) = @_;	1196	my ($self, $ev, $x, $y) = @_;
1119		1197
1120	delete $self->{motion};	1198	!!delete $self->{motion}
1121	}	1199	}
1122		1200
1123	sub mouse_motion {	1201	sub mouse_motion {
1124	my ($self, $ev, $x, $y) = @_;	1202	my ($self, $ev, $x, $y) = @_;
1125		1203
1126	$self->{motion}->($ev, $x, $y) if $self->{motion};	1204	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1205
		1206	!!$self->{motion}
1127	}	1207	}
1128		1208
1129	sub _draw {	1209	sub _draw {
1130	my ($self) = @_;	1210	my ($self) = @_;
1131		1211
		1212	my $child = $self->{children}[0];
		1213
1132	my ($w, $h ) = ($self->{w}, $self->{h});	1214	my ($w, $h ) = ($self->{w}, $self->{h});
1133	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1215	my ($cw, $ch) = ($child->{w}, $child->{h});
1134		1216
1135	glEnable GL_TEXTURE_2D;	1217	glEnable GL_TEXTURE_2D;
1136	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1218	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1137		1219
1138	my $border = $self->border;	1220	my $border = $self->border;
…		…
1153	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1235	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1154	}	1236	}
1155		1237
1156	glDisable GL_TEXTURE_2D;	1238	glDisable GL_TEXTURE_2D;
1157		1239
1158	$self->{title}->draw if $self->{title};
1159
1160	$self->child->draw;	1240	$child->draw;
		1241
		1242	if ($self->{title}) {
		1243	glTranslate 0, $border - $self->{h};
		1244	$self->{title}->_draw;
		1245	}
1161	}	1246	}
1162		1247
1163	#############################################################################	1248	#############################################################################
1164		1249
1165	package CFClient::UI::Table;	1250	package CFClient::UI::Table;
…		…
1239	(sum @$hs),	1324	(sum @$hs),
1240	)	1325	)
1241	}	1326	}
1242		1327
1243	sub size_allocate {	1328	sub size_allocate {
1244	my ($self, $w, $h, $changed) = @_;	1329	my ($self, $w, $h) = @_;
1245		1330
1246	my ($ws, $hs) = $self->get_wh;	1331	my ($ws, $hs) = $self->get_wh;
1247		1332
1248	my $req_w = (sum @$ws) || 1;	1333	my $req_w = (sum @$ws) || 1;
1249	my $req_h = (sum @$hs) || 1;	1334	my $req_h = (sum @$hs) || 1;
…		…
1327	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1412	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1328	)	1413	)
1329	}	1414	}
1330		1415
1331	sub size_allocate {	1416	sub size_allocate {
1332	my ($self, $w, $h, $changed) = @_;	1417	my ($self, $w, $h) = @_;
1333		1418
1334	my $space = $self->{vertical} ? $h : $w;	1419	my $space = $self->{vertical} ? $h : $w;
1335	my $children = $self->{children};	1420	my $children = $self->{children};
1336		1421
1337	my @req;	1422	my @req;
…		…
1420	ellipsise => 3, # end	1505	ellipsise => 3, # end
1421	layout => (new CFClient::Layout),	1506	layout => (new CFClient::Layout),
1422	fontsize => 1,	1507	fontsize => 1,
1423	align => -1,	1508	align => -1,
1424	valign => -1,	1509	valign => -1,
1425	padding => 2,	1510	padding_x => 2,
		1511	padding_y => 2,
1426	can_events => 0,	1512	can_events => 0,
1427	%arg	1513	%arg
1428	);	1514	);
1429		1515
1430	if (exists $self->{template}) {	1516	if (exists $self->{template}) {
…		…
1457		1543
1458	delete $self->{texture};	1544	delete $self->{texture};
1459	$self->SUPER::update;	1545	$self->SUPER::update;
1460	}	1546	}
1461		1547
		1548	sub realloc {
		1549	my ($self) = @_;
		1550
		1551	delete $self->{ox};
		1552	$self->SUPER::realloc;
		1553	}
		1554
1462	sub set_text {	1555	sub set_text {
1463	my ($self, $text) = @_;	1556	my ($self, $text) = @_;
1464		1557
1465	return if $self->{text} eq "T$text";	1558	return if $self->{text} eq "T$text";
1466	$self->{text} = "T$text";	1559	$self->{text} = "T$text";
1467		1560
1468	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1561	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1469	$self->{layout}->set_text ($text);	1562	$self->{layout}->set_text ($text);
1470		1563
		1564	delete $self->{req_h};
1471	$self->realloc;	1565	$self->realloc;
1472	$self->update;	1566	$self->update;
1473	}	1567	}
1474		1568
1475	sub set_markup {	1569	sub set_markup {
…		…
1481	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1575	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1482		1576
1483	$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;
1484	$self->{layout}->set_markup ($markup);	1578	$self->{layout}->set_markup ($markup);
1485		1579
		1580	delete $self->{req_h};
1486	$self->realloc;	1581	$self->realloc;
1487	$self->update;	1582	$self->update;
1488	}	1583	}
1489		1584
1490	sub size_request {	1585	sub size_request {
1491	my ($self) = @_;	1586	my ($self) = @_;
1492		1587
		1588	if (exists $self->{req_h}) {
		1589	@$self{qw(req_w req_h)}
		1590	} else {
1493	$self->{layout}->set_font ($self->{font}) if $self->{font};	1591	$self->{layout}->set_font ($self->{font}) if $self->{font};
1494	$self->{layout}->set_width ($self->{max_w} || -1);	1592	$self->{layout}->set_width ($self->{max_w} || -1);
1495	$self->{layout}->set_ellipsise ($self->{ellipsise});	1593	$self->{layout}->set_ellipsise ($self->{ellipsise});
1496	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1594	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1497	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1595	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1498		1596
1499	my ($w, $h) = $self->{layout}->size;	1597	my ($w, $h) = $self->{layout}->size;
1500		1598
1501	if (exists $self->{template}) {	1599	if (exists $self->{template}) {
1502	$self->{template}->set_font ($self->{font}) if $self->{font};	1600	$self->{template}->set_font ($self->{font}) if $self->{font};
1503	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1601	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1504		1602
1505	my ($w2, $h2) = $self->{template}->size;	1603	my ($w2, $h2) = $self->{template}->size;
1506		1604
1507	$w = List::Util::max $w, $w2;	1605	$w = List::Util::max $w, $w2;
1508	$h = List::Util::max $h, $h2;	1606	$h = List::Util::max $h, $h2;
1509	}	1607	}
1510		1608
		1609	($w, $h)
1511	(	1610	}
1512	$w + $self->{padding} * 2,
1513	$h + $self->{padding} * 2,
1514	)
1515	}	1611	}
1516		1612
1517	sub size_allocate {	1613	sub size_allocate {
1518	my ($self, $w, $h, $changed) = @_;	1614	my ($self, $w, $h) = @_;
		1615
		1616	delete $self->{ox};
1519		1617
1520	delete $self->{texture}	1618	delete $self->{texture}
1521	if $changed;	1619	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1522	}	1620	}
1523		1621
1524	sub set_fontsize {	1622	sub set_fontsize {
1525	my ($self, $fontsize) = @_;	1623	my ($self, $fontsize) = @_;
1526		1624
…		…
1541	$self->{layout}->set_width ($self->{w});	1639	$self->{layout}->set_width ($self->{w});
1542	$self->{layout}->set_ellipsise ($self->{ellipsise});	1640	$self->{layout}->set_ellipsise ($self->{ellipsise});
1543	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1641	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1544	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1642	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1545		1643
1546	my $tex = new_from_layout CFClient::Texture $self->{layout};	1644	new_from_layout CFClient::Texture $self->{layout}
		1645	};
1547		1646
		1647	unless (exists $self->{ox}) {
1548	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1648	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1549	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1649	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1550	: ($self->{w} - $tex->{w}) * 0.5);	1650	: ($self->{w} - $tex->{w}) * 0.5);
1551		1651
1552	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1652	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1553	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1653	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1554	: ($self->{h} - $tex->{h}) * 0.5);	1654	: ($self->{h} - $tex->{h}) * 0.5);
1555
1556	$tex
1557	};	1655	};
1558		1656
1559	glEnable GL_TEXTURE_2D;	1657	glEnable GL_TEXTURE_2D;
1560	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1561		1658
1562	if ($tex->{format} == GL_ALPHA) {	1659	if ($tex->{format} == GL_ALPHA) {
		1660	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1563	glColor @{$self->{fg}};	1661	glColor @{$self->{fg}};
1564	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1662	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1565	} else {	1663	} else {
		1664	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1566	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1665	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1567	}	1666	}
1568		1667
1569	glDisable GL_TEXTURE_2D;	1668	glDisable GL_TEXTURE_2D;
1570	}	1669	}
…		…
1599		1698
1600	delete $self->{cur_h};	1699	delete $self->{cur_h};
1601		1700
1602	return if $self->{text} eq $text;	1701	return if $self->{text} eq $text;
1603		1702
1604	delete $self->{texture};
1605
1606	$self->{last_activity} = $::NOW;	1703	$self->{last_activity} = $::NOW;
1607	$self->{text} = $text;	1704	$self->{text} = $text;
1608		1705
1609	$text =~ s/./*/g if $self->{hidden};	1706	$text =~ s/./*/g if $self->{hidden};
1610	$self->{layout}->set_text ("$text ");	1707	$self->{layout}->set_text ("$text ");
		1708	delete $self->{req_h};
1611		1709
1612	$self->_emit (changed => $self->{text});	1710	$self->_emit (changed => $self->{text});
		1711
		1712	$self->realloc;
		1713	$self->update;
1613	}	1714	}
1614		1715
1615	sub set_text {	1716	sub set_text {
1616	my ($self, $text) = @_;	1717	my ($self, $text) = @_;
1617		1718
1618	$self->{cursor} = length $text;	1719	$self->{cursor} = length $text;
1619	$self->_set_text ($text);	1720	$self->_set_text ($text);
1620
1621	$self->realloc;
1622	}	1721	}
1623		1722
1624	sub get_text {	1723	sub get_text {
1625	$_[0]{text}	1724	$_[0]{text}
1626	}	1725	}
…		…
1656	$self->{cursor} = length $text;	1755	$self->{cursor} = length $text;
1657	} elsif ($uni == 27) {	1756	} elsif ($uni == 27) {
1658	$self->_emit ('escape');	1757	$self->_emit ('escape');
1659	} elsif ($uni) {	1758	} elsif ($uni) {
1660	substr $text, $self->{cursor}++, 0, chr $uni;	1759	substr $text, $self->{cursor}++, 0, chr $uni;
		1760	} else {
		1761	return 0;
1661	}	1762	}
1662		1763
1663	$self->_set_text ($text);	1764	$self->_set_text ($text);
1664		1765
1665	$self->realloc;	1766	$self->realloc;
		1767
		1768	1
1666	}	1769	}
1667		1770
1668	sub focus_in {	1771	sub focus_in {
1669	my ($self) = @_;	1772	my ($self) = @_;
1670		1773
…		…
1685	utf8::encode $text;	1788	utf8::encode $text;
1686	$self->{cursor} = length substr $text, 0, $idx;	1789	$self->{cursor} = length substr $text, 0, $idx;
1687		1790
1688	$self->_set_text ($self->{text});	1791	$self->_set_text ($self->{text});
1689	$self->update;	1792	$self->update;
		1793
		1794	1
1690	}	1795	}
1691		1796
1692	sub mouse_motion {	1797	sub mouse_motion {
1693	my ($self, $ev, $x, $y) = @_;	1798	my ($self, $ev, $x, $y) = @_;
1694	# 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
1695	}	1802	}
1696		1803
1697	sub _draw {	1804	sub _draw {
1698	my ($self) = @_;	1805	my ($self) = @_;
1699		1806
1700	local $self->{fg} = $self->{fg};	1807	local $self->{fg} = $self->{fg};
1701		1808
1702	if ($FOCUS == $self) {	1809	if ($FOCUS == $self) {
1703	glColor @{$self->{active_bg}};	1810	glColor_premultiply @{$self->{active_bg}};
1704	$self->{fg} = $self->{active_fg};	1811	$self->{fg} = $self->{active_fg};
1705	} else {	1812	} else {
1706	glColor @{$self->{bg}};	1813	glColor_premultiply @{$self->{bg}};
1707	}	1814	}
1708		1815
1709	glEnable GL_BLEND;	1816	glEnable GL_BLEND;
1710	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1817	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1711	glBegin GL_QUADS;	1818	glBegin GL_QUADS;
1712	glVertex 0 , 0;	1819	glVertex 0 , 0;
1713	glVertex 0 , $self->{h};	1820	glVertex 0 , $self->{h};
1714	glVertex $self->{w}, $self->{h};	1821	glVertex $self->{w}, $self->{h};
1715	glVertex $self->{w}, 0;	1822	glVertex $self->{w}, 0;
…		…
1776	} else {	1883	} else {
1777	$self->set_text ($self->{history_saveback});	1884	$self->set_text ($self->{history_saveback});
1778	}	1885	}
1779		1886
1780	} else {	1887	} else {
1781	$self->SUPER::key_down ($ev);	1888	return $self->SUPER::key_down ($ev)
		1889	}
		1890
1782	}	1891	1
1783
1784	}	1892	}
1785		1893
1786	#############################################################################	1894	#############################################################################
1787		1895
1788	package CFClient::UI::Button;	1896	package CFClient::UI::Button;
…		…
1797		1905
1798	sub new {	1906	sub new {
1799	my $class = shift;	1907	my $class = shift;
1800		1908
1801	$class->SUPER::new (	1909	$class->SUPER::new (
1802	padding => 4,	1910	padding_x => 4,
		1911	padding_y => 4,
1803	fg => [1, 1, 1],	1912	fg => [1, 1, 1],
1804	active_fg => [0, 0, 1],	1913	active_fg => [0, 0, 1],
1805	can_hover => 1,	1914	can_hover => 1,
1806	align => 0,	1915	align => 0,
1807	valign => 0,	1916	valign => 0,
…		…
1816	my ($self, $ev, $x, $y) = @_;	1925	my ($self, $ev, $x, $y) = @_;
1817		1926
1818	$self->emit ("activate")	1927	$self->emit ("activate")
1819	if $x >= 0 && $x < $self->{w}	1928	if $x >= 0 && $x < $self->{w}
1820	&& $y >= 0 && $y < $self->{h};	1929	&& $y >= 0 && $y < $self->{h};
		1930
		1931	1
1821	}	1932	}
1822		1933
1823	sub _draw {	1934	sub _draw {
1824	my ($self) = @_;	1935	my ($self) = @_;
1825		1936
1826	local $self->{fg} = $self->{fg};	1937	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1827
1828	if ($GRAB == $self) {
1829	$self->{fg} = $self->{active_fg};
1830	}
1831		1938
1832	glEnable GL_TEXTURE_2D;	1939	glEnable GL_TEXTURE_2D;
1833	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1940	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1834	glColor 0, 0, 0, 1;	1941	glColor 0, 0, 0, 1;
1835		1942
…		…
1854		1961
1855	sub new {	1962	sub new {
1856	my $class = shift;	1963	my $class = shift;
1857		1964
1858	$class->SUPER::new (	1965	$class->SUPER::new (
1859	padding => 2,	1966	padding_x => 2,
		1967	padding_y => 2,
1860	fg => [1, 1, 1],	1968	fg => [1, 1, 1],
1861	active_fg => [1, 1, 0],	1969	active_fg => [1, 1, 0],
1862	bg => [0, 0, 0, 0.2],	1970	bg => [0, 0, 0, 0.2],
1863	active_bg => [1, 1, 1, 0.5],	1971	active_bg => [1, 1, 1, 0.5],
1864	state => 0,	1972	state => 0,
…		…
1868	}	1976	}
1869		1977
1870	sub size_request {	1978	sub size_request {
1871	my ($self) = @_;	1979	my ($self) = @_;
1872		1980
1873	($self->{padding} * 2 + 6) x 2	1981	(6) x 2
1874	}	1982	}
1875		1983
1876	sub button_down {	1984	sub button_down {
1877	my ($self, $ev, $x, $y) = @_;	1985	my ($self, $ev, $x, $y) = @_;
1878		1986
1879	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1987	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1880	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1988	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1881	$self->{state} = !$self->{state};	1989	$self->{state} = !$self->{state};
1882	$self->_emit (changed => $self->{state});	1990	$self->_emit (changed => $self->{state});
		1991	} else {
		1992	return 0
		1993	}
		1994
1883	}	1995	1
1884	}	1996	}
1885		1997
1886	sub _draw {	1998	sub _draw {
1887	my ($self) = @_;	1999	my ($self) = @_;
1888		2000
1889	$self->SUPER::_draw;	2001	$self->SUPER::_draw;
1890		2002
1891	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	2003	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1892		2004
1893	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	2005	my ($w, $h) = @$self{qw(w h)};
		2006
		2007	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1894		2008
1895	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2009	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1896		2010
1897	my $tex = $self->{state} ? $tex[1] : $tex[0];	2011	my $tex = $self->{state} ? $tex[1] : $tex[0];
1898		2012
…		…
2053		2167
2054	my $h1 = $self->{h} * (1 - $ycut1);	2168	my $h1 = $self->{h} * (1 - $ycut1);
2055	my $h2 = $self->{h} * (1 - $ycut2);	2169	my $h2 = $self->{h} * (1 - $ycut2);
2056		2170
2057	glEnable GL_BLEND;	2171	glEnable GL_BLEND;
2058	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;
2059	glEnable GL_TEXTURE_2D;	2174	glEnable GL_TEXTURE_2D;
2060	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2175	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2061		2176
2062	glBindTexture GL_TEXTURE_2D, $t1->{name};	2177	glBindTexture GL_TEXTURE_2D, $t1->{name};
2063	glBegin GL_QUADS;	2178	glBegin GL_QUADS;
…		…
2224		2339
2225	$self->SUPER::button_down ($ev, $x, $y);	2340	$self->SUPER::button_down ($ev, $x, $y);
2226		2341
2227	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2342	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2228		2343
2229	$self->mouse_motion ($ev, $x, $y);	2344	$self->mouse_motion ($ev, $x, $y)
2230	}	2345	}
2231		2346
2232	sub mouse_motion {	2347	sub mouse_motion {
2233	my ($self, $ev, $x, $y) = @_;	2348	my ($self, $ev, $x, $y) = @_;
2234		2349
…		…
2238	my (undef, $lo, $hi, $page) = @{$self->{range}};	2353	my (undef, $lo, $hi, $page) = @{$self->{range}};
2239		2354
2240	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2355	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2241		2356
2242	$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
2243	}	2362	1
2244	}	2363	}
2245		2364
2246	sub update {	2365	sub update {
2247	my ($self) = @_;	2366	my ($self) = @_;
2248		2367
2249	$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}) {
2250	$self->set_value ($self->{range}[0]);	2376	$self->set_value ($self->{range}[0]);
2251		2377
2252	my ($value, $lo, $hi, $page) = @{$self->{range}};	2378	my ($value, $lo, $hi, $page) = @{$self->{range}};
2253	my $range = ($hi - $page - $lo) || 1e-100;	2379	my $range = ($hi - $page - $lo) || 1e-100;
2254		2380
…		…
2260	$value = ($value - $lo) / $range;	2386	$value = ($value - $lo) / $range;
2261	$value = $value * $self->{scale} + $self->{offset};	2387	$value = $value * $self->{scale} + $self->{offset};
2262		2388
2263	$self->{knob_x} = $value - $knob_w * 0.5;	2389	$self->{knob_x} = $value - $knob_w * 0.5;
2264	$self->{knob_w} = $knob_w;	2390	$self->{knob_w} = $knob_w;
2265	});	2391	}
2266
2267	$self->SUPER::update;
2268	}
2269
2270	sub _draw {
2271	my ($self) = @_;
2272		2392
2273	$self->SUPER::_draw ();	2393	$self->SUPER::_draw ();
2274		2394
2275	glScale $self->{w}, $self->{h};	2395	glScale $self->{w}, $self->{h};
2276		2396
…		…
2374	$self->{fontsize} = $fontsize;	2494	$self->{fontsize} = $fontsize;
2375	$self->reflow;	2495	$self->reflow;
2376	}	2496	}
2377		2497
2378	sub size_allocate {	2498	sub size_allocate {
2379	my ($self, $w, $h, $changed) = @_;	2499	my ($self, $w, $h) = @_;
2380		2500
2381	$self->SUPER::size_allocate ($w, $h, $changed);	2501	$self->SUPER::size_allocate ($w, $h);
2382
2383	return unless $changed;
2384		2502
2385	$self->{layout}->set_font ($self->{font}) if $self->{font};	2503	$self->{layout}->set_font ($self->{font}) if $self->{font};
2386	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2504	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2387	$self->{layout}->set_width ($self->{children}[0]{w});	2505	$self->{layout}->set_width ($self->{children}[0]{w});
2388		2506
…		…
2472		2590
2473	delete $self->{texture};	2591	delete $self->{texture};
2474	}	2592	}
2475		2593
2476	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2594	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2477	glClearColor 0.5, 0.5, 0.5, 0;	2595	glClearColor 0, 0, 0, 0;
2478	glClear GL_COLOR_BUFFER_BIT;	2596	glClear GL_COLOR_BUFFER_BIT;
2479		2597
2480	my $top = int $self->{children}[1]{range}[0];	2598	my $top = int $self->{children}[1]{range}[0];
2481		2599
2482	my $y0 = $top;	2600	my $y0 = $top;
…		…
2517	sub _draw {	2635	sub _draw {
2518	my ($self) = @_;	2636	my ($self) = @_;
2519		2637
2520	glEnable GL_TEXTURE_2D;	2638	glEnable GL_TEXTURE_2D;
2521	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2639	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2522	glColor 1, 1, 1, 1;	2640	glColor 0, 0, 0, 1;
2523	$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});
2524	glDisable GL_TEXTURE_2D;	2642	glDisable GL_TEXTURE_2D;
2525		2643
2526	$self->{children}[1]->draw;	2644	$self->{children}[1]->draw;
2527		2645
2528	}	2646	}
…		…
2611	}	2729	}
2612		2730
2613	sub set_tooltip_from {	2731	sub set_tooltip_from {
2614	my ($self, $widget) = @_;	2732	my ($self, $widget) = @_;
2615		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
2616	$self->add (new CFClient::UI::Label	2743	$self->add (new CFClient::UI::Label
2617	markup => $widget->{tooltip},	2744	markup => $tooltip,
2618	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2745	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2619	fontsize => 0.8,	2746	fontsize => 0.8,
2620	fg => [0, 0, 0, 1],	2747	fg => [0, 0, 0, 1],
2621	ellipsise => 0,	2748	ellipsise => 0,
2622	font => ($widget->{tooltip_font} || $::FONT_PROP),	2749	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2630		2757
2631	($w + 4, $h + 4)	2758	($w + 4, $h + 4)
2632	}	2759	}
2633		2760
2634	sub size_allocate {	2761	sub size_allocate {
2635	my ($self, $w, $h, $changed) = @_;	2762	my ($self, $w, $h) = @_;
2636		2763
2637	return unless $changed;
2638
2639	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2764	$self->SUPER::size_allocate ($w - 4, $h - 4);
2640	}	2765	}
2641		2766
2642	sub visibility_change {	2767	sub visibility_change {
2643	my ($self, $visible) = @_;	2768	my ($self, $visible) = @_;
2644		2769
…		…
2748	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2873	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2749		2874
2750	if ($tex) {	2875	if ($tex) {
2751	glEnable GL_TEXTURE_2D;	2876	glEnable GL_TEXTURE_2D;
2752	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2877	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2753	glColor 1, 1, 1, 1;	2878	glColor 0, 0, 0, 1;
2754	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2879	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2755	glDisable GL_TEXTURE_2D;	2880	glDisable GL_TEXTURE_2D;
2756	}	2881	}
2757	}	2882	}
2758		2883
…		…
2765	$self->SUPER::DESTROY;	2890	$self->SUPER::DESTROY;
2766	}	2891	}
2767		2892
2768	#############################################################################	2893	#############################################################################
2769		2894
2770	package CFClient::UI::Inventory;	2895	package CFClient::UI::Buttonbar;
2771		2896
2772	our @ISA = CFClient::UI::ScrolledWindow::;	2897	our @ISA = CFClient::UI::HBox::;
2773		2898
2774	sub new {	2899	# 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		2900
2810	#############################################################################	2901	#############################################################################
2811		2902
2812	package CFClient::UI::Menu;	2903	package CFClient::UI::Menu;
2813		2904
…		…
2854	# maybe save $GRAB? must be careful about events...	2945	# maybe save $GRAB? must be careful about events...
2855	$GRAB = $self;	2946	$GRAB = $self;
2856	$self->{button} = $ev->{button};	2947	$self->{button} = $ev->{button};
2857		2948
2858	$self->show;	2949	$self->show;
2859	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2950	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2860	}	2951	}
2861		2952
2862	sub mouse_motion {	2953	sub mouse_motion {
2863	my ($self, $ev, $x, $y) = @_;	2954	my ($self, $ev, $x, $y) = @_;
2864		2955
2865	# TODO: should use vbox->find_widget or so	2956	# TODO: should use vbox->find_widget or so
2866	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2957	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2867	$self->{hover} = $self->{item}{$HOVER};	2958	$self->{hover} = $self->{item}{$HOVER};
		2959
		2960	0
2868	}	2961	}
2869		2962
2870	sub button_up {	2963	sub button_up {
2871	my ($self, $ev, $x, $y) = @_;	2964	my ($self, $ev, $x, $y) = @_;
2872		2965
…		…
2874	undef $GRAB;	2967	undef $GRAB;
2875	$self->hide;	2968	$self->hide;
2876		2969
2877	$self->_emit ("popdown");	2970	$self->_emit ("popdown");
2878	$self->{hover}[1]->() if $self->{hover};	2971	$self->{hover}[1]->() if $self->{hover};
		2972	} else {
		2973	return 0
		2974	}
		2975
2879	}	2976	1
2880	}	2977	}
2881		2978
2882	#############################################################################	2979	#############################################################################
2883		2980
2884	package CFClient::UI::Statusbox;	2981	package CFClient::UI::Multiplexer;
2885		2982
2886	our @ISA = CFClient::UI::VBox::;	2983	our @ISA = CFClient::UI::Container::;
2887		2984
2888	sub new {	2985	sub new {
2889	my $class = shift;	2986	my $class = shift;
2890		2987
2891	$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 (
2892	fontsize => 0.8,	3097	fontsize => 0.8,
2893	@_,	3098	@_,
2894	)	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
2895	}	3106	}
2896		3107
2897	sub reorder {	3108	sub reorder {
2898	my ($self) = @_;	3109	my ($self) = @_;
2899	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} };
2900		3116
2901	while (my ($k, $v) = each %{ $self->{item} }) {	3117	while (my ($k, $v) = each %{ $self->{item} }) {
2902	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3118	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2903	}	3119	}
2904		3120
…		…
2907	my @items = sort {	3123	my @items = sort {
2908	$a->{pri} <=> $b->{pri}	3124	$a->{pri} <=> $b->{pri}
2909	or $b->{id} <=> $a->{id}	3125	or $b->{id} <=> $a->{id}
2910	} values %{ $self->{item} };	3126	} values %{ $self->{item} };
2911		3127
		3128	$self->{timer}->interval (1);
		3129
2912	my $count = 10 + 1;	3130	my $count = 10 + 1;
2913	for my $item (@items) {	3131	for my $item (@items) {
2914	last unless --$count;	3132	last unless --$count;
2915		3133
2916	push @widgets, $item->{label} ||= do {	3134	my $label = $item->{label} ||= do {
2917	# TODO: doesn't handle markup well (read as: at all)	3135	# TODO: doesn't handle markup well (read as: at all)
2918	my $short = $item->{count} > 1	3136	my $short = $item->{count} > 1
2919	? "<b>$item->{count} ×</b> $item->{text}"	3137	? "<b>$item->{count} ×</b> $item->{text}"
2920	: $item->{text};	3138	: $item->{text};
2921		3139
…		…
2929	tooltip => $item->{tooltip},	3147	tooltip => $item->{tooltip},
2930	tooltip_font => $::FONT_PROP,	3148	tooltip_font => $::FONT_PROP,
2931	tooltip_width => 0.67,	3149	tooltip_width => 0.67,
2932	fontsize => $item->{fontsize} || $self->{fontsize},	3150	fontsize => $item->{fontsize} || $self->{fontsize},
2933	max_w => $::WIDTH * 0.44,	3151	max_w => $::WIDTH * 0.44,
2934	fg => $item->{fg},	3152	fg => [@{ $item->{fg} }],
2935	can_events => 1,	3153	can_events => 1,
2936	can_hover => 1	3154	can_hover => 1
2937	};	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;
2938	}	3168	}
2939		3169
2940	$self->clear;	3170	$self->clear;
2941	$self->SUPER::add (reverse @widgets);	3171	$self->SUPER::add (reverse @widgets);
2942	}	3172	}
…		…
2947	$text =~ s/^\s+//;	3177	$text =~ s/^\s+//;
2948	$text =~ s/\s+$//;	3178	$text =~ s/\s+$//;
2949		3179
2950	return unless $text;	3180	return unless $text;
2951		3181
2952	my $timeout = time + ((delete $arg{timeout}) || 60);	3182	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2953		3183
2954	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3184	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2955		3185
2956	if (my $item = $self->{item}{$group}) {	3186	if (my $item = $self->{item}{$group}) {
2957	if ($item->{text} eq $text) {	3187	if ($item->{text} eq $text) {
…		…
2987		3217
2988	$self->reorder;	3218	$self->reorder;
2989	$self->SUPER::reconfigure;	3219	$self->SUPER::reconfigure;
2990	}	3220	}
2991		3221
		3222	sub DESTROY {
		3223	my ($self) = @_;
		3224
		3225	$self->{timer}->cancel;
		3226
		3227	$self->SUPER::DESTROY;
		3228	}
		3229
2992	#############################################################################	3230	#############################################################################
2993		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
2994	package CFClient::UI::Root;	3527	package CFClient::UI::Root;
2995		3528
2996	our @ISA = CFClient::UI::Container::;	3529	our @ISA = CFClient::UI::Container::;
		3530
		3531	use List::Util qw(min max);
2997		3532
2998	use CFClient::OpenGL;	3533	use CFClient::OpenGL;
2999		3534
3000	sub new {	3535	sub new {
3001	my $class = shift;	3536	my $class = shift;
…		…
3008	Scalar::Util::weaken ($self->{root} = $self);	3543	Scalar::Util::weaken ($self->{root} = $self);
3009		3544
3010	$self	3545	$self
3011	}	3546	}
3012		3547
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 {	3548	sub size_request {
3030	my ($self) = @_;	3549	my ($self) = @_;
3031		3550
3032	($self->{w}, $self->{h})	3551	($self->{w}, $self->{h})
3033	}	3552	}
…		…
3045		3564
3046	int $coord + 0.5	3565	int $coord + 0.5
3047	}	3566	}
3048		3567
3049	sub size_allocate {	3568	sub size_allocate {
3050	my ($self, $w, $h, $changed) = @_;	3569	my ($self, $w, $h) = @_;
3051		3570
3052	for my $child ($self->children) {	3571	for my $child ($self->children) {
3053	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)};
3054		3573
3055	$X = $child->{force_x} if exists $child->{force_x};	3574	$X = $child->{force_x} if exists $child->{force_x};
…		…
3123	$_->()	3642	$_->()
3124	for values %{delete $self->{refresh_hook}};	3643	for values %{delete $self->{refresh_hook}};
3125	}	3644	}
3126		3645
3127	if ($self->{realloc}) {	3646	if ($self->{realloc}) {
		3647	my %queue;
3128	my @queue;	3648	my @queue;
		3649	my $widget;
3129		3650
		3651	outer:
3130	while () {	3652	while () {
3131	if ($self->{realloc}) {	3653	if (my $realloc = delete $self->{realloc}) {
3132	#TODO use array-of-depth approach	3654	for $widget (values %$realloc) {
		3655	$widget->{visible} or next; # do not resize invisible widgets
3133		3656
3134	@queue = sort { $a->{visible} <=> $b->{visible} }	3657	$queue{$widget+0}++ and next; # duplicates are common
3135	@queue, values %{delete $self->{realloc}};	3658
		3659	push @{ $queue[$widget->{visible}] }, $widget;
		3660	}
3136	}	3661	}
3137		3662
		3663	while () {
		3664	@queue or last outer;
		3665
3138	my $widget = pop @queue || last;	3666	$widget = pop @{ $queue[-1] || [] }
		3667	and last;
		3668
		3669	pop @queue;
		3670	}
3139		3671
3140	$widget->{visible} or last; # do not resize invisible widgets	3672	delete $queue{$widget+0};
3141		3673
3142	my ($w, $h) = $widget->size_request;	3674	my ($w, $h) = $widget->size_request;
3143		3675
3144	my $min_size = $widget->{is_toplevel} ? 16 : 0;	3676	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3677	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3145		3678
3146	$w = List::Util::max $widget->{min_w} || $widget->{is_toplevel} * 16, $w;	3679	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
3147	$h = List::Util::max $widget->{min_h} || $widget->{is_toplevel} * 16, $h;	3680	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3148		3681
3149	$w = $widget->{force_w} if exists $widget->{force_w};	3682	$w = $widget->{force_w} if exists $widget->{force_w};
3150	$h = $widget->{force_h} if exists $widget->{force_h};	3683	$h = $widget->{force_h} if exists $widget->{force_h};
3151		3684
		3685	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3686	|| delete $widget->{force_realloc}) {
3152	$widget->{req_w} = $w;	3687	$widget->{req_w} = $w;
3153	$widget->{req_h} = $h;	3688	$widget->{req_h} = $h;
3154		3689
3155	$self->{size_alloc}{$widget} = [$widget, undef, undef];	3690	$self->{size_alloc}{$widget+0} = $widget;
3156		3691
3157	push @queue, $widget->{parent}	3692	if (my $parent = $widget->{parent}) {
3158	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};
3159	}	3702	}
3160	}	3703	}
3161		3704
3162	while (my $size_alloc = delete $self->{size_alloc}) {	3705	while (my $size_alloc = delete $self->{size_alloc}) {
3163	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3706	my @queue = sort { $b->{visible} <=> $a->{visible} }
3164	values %$size_alloc;	3707	values %$size_alloc;
3165		3708
3166	while () {	3709	while () {
3167	my ($widget, $w, $h) = @{ pop @queue or last };	3710	my $widget = pop @queue || last;
3168		3711
3169	$w = $widget->{w} || $widget->{req_w} unless defined $w;	3712	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3170	$h = $widget->{h} || $widget->{req_h} unless defined $h;
3171		3713
3172	$w = 0 if $w < 0;	3714	$w = 0 if $w < 0;
3173	$h = 0 if $h < 0;	3715	$h = 0 if $h < 0;
3174		3716
3175	$w = int $w + 0.5;	3717	$w = int $w + 0.5;
3176	$h = int $h + 0.5;	3718	$h = int $h + 0.5;
3177		3719
3178	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};
3179		3723
3180	$widget->{w} = $w;	3724	$widget->{w} = $w;
3181	$widget->{h} = $h;	3725	$widget->{h} = $h;
3182		3726
3183	$widget->emit (size_allocate => $w, $h, $changed);	3727	$widget->emit (size_allocate => $w, $h);
		3728	}
3184	}	3729	}
3185	}	3730	}
3186		3731
3187	while ($self->{post_alloc_hook}) {	3732	while ($self->{post_alloc_hook}) {
3188	$_->()	3733	$_->()
3189	for values %{delete $self->{post_alloc_hook}};	3734	for values %{delete $self->{post_alloc_hook}};
3190	}	3735	}
		3736
3191		3737
3192	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3738	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3193	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3739	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3194	glClear GL_COLOR_BUFFER_BIT;	3740	glClear GL_COLOR_BUFFER_BIT;
3195		3741
…		…
3197	glLoadIdentity;	3743	glLoadIdentity;
3198	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3744	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3199	glMatrixMode GL_MODELVIEW;	3745	glMatrixMode GL_MODELVIEW;
3200	glLoadIdentity;	3746	glLoadIdentity;
3201		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
3202	$self->_draw;	3755	$self->_draw;
3203	}	3756	}
3204		3757
3205	#############################################################################	3758	#############################################################################
3206		3759

Diff Legend

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