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.300 by root, Wed Jun 7 22:06:43 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);
…		…
308	}	315	}
309		316
310	sub move_abs {	317	sub move_abs {
311	my ($self, $x, $y, $z) = @_;	318	my ($self, $x, $y, $z) = @_;
312		319
313	$self->{x} = List::Util::max 0, int $x;	320	$self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
314	$self->{y} = List::Util::max 0, int $y;	321	$self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
315	$self->{z} = $z if defined $z;	322	$self->{z} = $z if defined $z;
316		323
317	$self->update;	324	$self->update;
318	}	325	}
319		326
…		…
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;	1662
		1663	my $w = List::Util::min $self->{w} + 4, $tex->{w};
		1664	my $h = List::Util::min $self->{h} + 2, $tex->{h};
1561		1665
1562	if ($tex->{format} == GL_ALPHA) {	1666	if ($tex->{format} == GL_ALPHA) {
		1667	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1563	glColor @{$self->{fg}};	1668	glColor @{$self->{fg}};
1564	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1669	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1565	} else {	1670	} else {
		1671	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1566	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1672	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1567	}	1673	}
1568		1674
1569	glDisable GL_TEXTURE_2D;	1675	glDisable GL_TEXTURE_2D;
1570	}	1676	}
1571		1677
…		…
1588	can_hover => 1,	1694	can_hover => 1,
1589	can_focus => 1,	1695	can_focus => 1,
1590	valign => 0,	1696	valign => 0,
1591	can_events => 1,	1697	can_events => 1,
1592	#text => ...	1698	#text => ...
		1699	#hidden => "*",
1593	@_	1700	@_
1594	)	1701	)
1595	}	1702	}
1596		1703
1597	sub _set_text {	1704	sub _set_text {
…		…
1599		1706
1600	delete $self->{cur_h};	1707	delete $self->{cur_h};
1601		1708
1602	return if $self->{text} eq $text;	1709	return if $self->{text} eq $text;
1603		1710
1604	delete $self->{texture};
1605
1606	$self->{last_activity} = $::NOW;	1711	$self->{last_activity} = $::NOW;
1607	$self->{text} = $text;	1712	$self->{text} = $text;
1608		1713
1609	$text =~ s/./*/g if $self->{hidden};	1714	$text =~ s/./*/g if $self->{hidden};
1610	$self->{layout}->set_text ("$text ");	1715	$self->{layout}->set_text ("$text ");
		1716	delete $self->{size_req};
1611		1717
1612	$self->_emit (changed => $self->{text});	1718	$self->_emit (changed => $self->{text});
		1719
		1720	$self->realloc;
		1721	$self->update;
1613	}	1722	}
1614		1723
1615	sub set_text {	1724	sub set_text {
1616	my ($self, $text) = @_;	1725	my ($self, $text) = @_;
1617		1726
1618	$self->{cursor} = length $text;	1727	$self->{cursor} = length $text;
1619	$self->_set_text ($text);	1728	$self->_set_text ($text);
1620
1621	$self->realloc;
1622	}	1729	}
1623		1730
1624	sub get_text {	1731	sub get_text {
1625	$_[0]{text}	1732	$_[0]{text}
1626	}	1733	}
…		…
1656	$self->{cursor} = length $text;	1763	$self->{cursor} = length $text;
1657	} elsif ($uni == 27) {	1764	} elsif ($uni == 27) {
1658	$self->_emit ('escape');	1765	$self->_emit ('escape');
1659	} elsif ($uni) {	1766	} elsif ($uni) {
1660	substr $text, $self->{cursor}++, 0, chr $uni;	1767	substr $text, $self->{cursor}++, 0, chr $uni;
		1768	} else {
		1769	return 0;
1661	}	1770	}
1662		1771
1663	$self->_set_text ($text);	1772	$self->_set_text ($text);
1664		1773
1665	$self->realloc;	1774	$self->realloc;
		1775
		1776	1
1666	}	1777	}
1667		1778
1668	sub focus_in {	1779	sub focus_in {
1669	my ($self) = @_;	1780	my ($self) = @_;
1670		1781
…		…
1685	utf8::encode $text;	1796	utf8::encode $text;
1686	$self->{cursor} = length substr $text, 0, $idx;	1797	$self->{cursor} = length substr $text, 0, $idx;
1687		1798
1688	$self->_set_text ($self->{text});	1799	$self->_set_text ($self->{text});
1689	$self->update;	1800	$self->update;
		1801
		1802	1
1690	}	1803	}
1691		1804
1692	sub mouse_motion {	1805	sub mouse_motion {
1693	my ($self, $ev, $x, $y) = @_;	1806	my ($self, $ev, $x, $y) = @_;
1694	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1807	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1808
		1809	0
1695	}	1810	}
1696		1811
1697	sub _draw {	1812	sub _draw {
1698	my ($self) = @_;	1813	my ($self) = @_;
1699		1814
1700	local $self->{fg} = $self->{fg};	1815	local $self->{fg} = $self->{fg};
1701		1816
1702	if ($FOCUS == $self) {	1817	if ($FOCUS == $self) {
1703	glColor @{$self->{active_bg}};	1818	glColor_premultiply @{$self->{active_bg}};
1704	$self->{fg} = $self->{active_fg};	1819	$self->{fg} = $self->{active_fg};
1705	} else {	1820	} else {
1706	glColor @{$self->{bg}};	1821	glColor_premultiply @{$self->{bg}};
1707	}	1822	}
1708		1823
1709	glEnable GL_BLEND;	1824	glEnable GL_BLEND;
1710	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1825	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1711	glBegin GL_QUADS;	1826	glBegin GL_QUADS;
1712	glVertex 0 , 0;	1827	glVertex 0 , 0;
1713	glVertex 0 , $self->{h};	1828	glVertex 0 , $self->{h};
1714	glVertex $self->{w}, $self->{h};	1829	glVertex $self->{w}, $self->{h};
1715	glVertex $self->{w}, 0;	1830	glVertex $self->{w}, 0;
…		…
1776	} else {	1891	} else {
1777	$self->set_text ($self->{history_saveback});	1892	$self->set_text ($self->{history_saveback});
1778	}	1893	}
1779		1894
1780	} else {	1895	} else {
1781	$self->SUPER::key_down ($ev);	1896	return $self->SUPER::key_down ($ev)
		1897	}
		1898
1782	}	1899	1
1783
1784	}	1900	}
1785		1901
1786	#############################################################################	1902	#############################################################################
1787		1903
1788	package CFClient::UI::Button;	1904	package CFClient::UI::Button;
…		…
1797		1913
1798	sub new {	1914	sub new {
1799	my $class = shift;	1915	my $class = shift;
1800		1916
1801	$class->SUPER::new (	1917	$class->SUPER::new (
1802	padding => 4,	1918	padding_x => 4,
		1919	padding_y => 4,
1803	fg => [1, 1, 1],	1920	fg => [1, 1, 1],
1804	active_fg => [0, 0, 1],	1921	active_fg => [0, 0, 1],
1805	can_hover => 1,	1922	can_hover => 1,
1806	align => 0,	1923	align => 0,
1807	valign => 0,	1924	valign => 0,
…		…
1816	my ($self, $ev, $x, $y) = @_;	1933	my ($self, $ev, $x, $y) = @_;
1817		1934
1818	$self->emit ("activate")	1935	$self->emit ("activate")
1819	if $x >= 0 && $x < $self->{w}	1936	if $x >= 0 && $x < $self->{w}
1820	&& $y >= 0 && $y < $self->{h};	1937	&& $y >= 0 && $y < $self->{h};
		1938
		1939	1
1821	}	1940	}
1822		1941
1823	sub _draw {	1942	sub _draw {
1824	my ($self) = @_;	1943	my ($self) = @_;
1825		1944
1826	local $self->{fg} = $self->{fg};	1945	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1827
1828	if ($GRAB == $self) {
1829	$self->{fg} = $self->{active_fg};
1830	}
1831		1946
1832	glEnable GL_TEXTURE_2D;	1947	glEnable GL_TEXTURE_2D;
1833	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1948	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1834	glColor 0, 0, 0, 1;	1949	glColor 0, 0, 0, 1;
1835		1950
…		…
1854		1969
1855	sub new {	1970	sub new {
1856	my $class = shift;	1971	my $class = shift;
1857		1972
1858	$class->SUPER::new (	1973	$class->SUPER::new (
1859	padding => 2,	1974	padding_x => 2,
		1975	padding_y => 2,
1860	fg => [1, 1, 1],	1976	fg => [1, 1, 1],
1861	active_fg => [1, 1, 0],	1977	active_fg => [1, 1, 0],
1862	bg => [0, 0, 0, 0.2],	1978	bg => [0, 0, 0, 0.2],
1863	active_bg => [1, 1, 1, 0.5],	1979	active_bg => [1, 1, 1, 0.5],
1864	state => 0,	1980	state => 0,
…		…
1868	}	1984	}
1869		1985
1870	sub size_request {	1986	sub size_request {
1871	my ($self) = @_;	1987	my ($self) = @_;
1872		1988
1873	($self->{padding} * 2 + 6) x 2	1989	(6) x 2
1874	}	1990	}
1875		1991
1876	sub button_down {	1992	sub button_down {
1877	my ($self, $ev, $x, $y) = @_;	1993	my ($self, $ev, $x, $y) = @_;
1878		1994
1879	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1995	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1880	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1996	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1881	$self->{state} = !$self->{state};	1997	$self->{state} = !$self->{state};
1882	$self->_emit (changed => $self->{state});	1998	$self->_emit (changed => $self->{state});
		1999	} else {
		2000	return 0
		2001	}
		2002
1883	}	2003	1
1884	}	2004	}
1885		2005
1886	sub _draw {	2006	sub _draw {
1887	my ($self) = @_;	2007	my ($self) = @_;
1888		2008
1889	$self->SUPER::_draw;	2009	$self->SUPER::_draw;
1890		2010
1891	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	2011	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1892		2012
1893	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	2013	my ($w, $h) = @$self{qw(w h)};
		2014
		2015	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1894		2016
1895	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2017	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1896		2018
1897	my $tex = $self->{state} ? $tex[1] : $tex[0];	2019	my $tex = $self->{state} ? $tex[1] : $tex[0];
1898		2020
…		…
2053		2175
2054	my $h1 = $self->{h} * (1 - $ycut1);	2176	my $h1 = $self->{h} * (1 - $ycut1);
2055	my $h2 = $self->{h} * (1 - $ycut2);	2177	my $h2 = $self->{h} * (1 - $ycut2);
2056		2178
2057	glEnable GL_BLEND;	2179	glEnable GL_BLEND;
2058	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2180	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2181	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2059	glEnable GL_TEXTURE_2D;	2182	glEnable GL_TEXTURE_2D;
2060	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2183	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2061		2184
2062	glBindTexture GL_TEXTURE_2D, $t1->{name};	2185	glBindTexture GL_TEXTURE_2D, $t1->{name};
2063	glBegin GL_QUADS;	2186	glBegin GL_QUADS;
…		…
2184	sub set_range {	2307	sub set_range {
2185	my ($self, $range) = @_;	2308	my ($self, $range) = @_;
2186		2309
2187	($range, $self->{range}) = ($self->{range}, $range);	2310	($range, $self->{range}) = ($self->{range}, $range);
2188		2311
2189	$self->update
2190	if "@$range" ne "@{$self->{range}}";	2312	if ("@$range" ne "@{$self->{range}}") {
		2313	$self->update;
		2314	$self->set_value ($self->{range}[0]);
		2315	}
2191	}	2316	}
2192		2317
2193	sub set_value {	2318	sub set_value {
2194	my ($self, $value) = @_;	2319	my ($self, $value) = @_;
2195		2320
…		…
2224		2349
2225	$self->SUPER::button_down ($ev, $x, $y);	2350	$self->SUPER::button_down ($ev, $x, $y);
2226		2351
2227	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2352	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2228		2353
2229	$self->mouse_motion ($ev, $x, $y);	2354	$self->mouse_motion ($ev, $x, $y)
2230	}	2355	}
2231		2356
2232	sub mouse_motion {	2357	sub mouse_motion {
2233	my ($self, $ev, $x, $y) = @_;	2358	my ($self, $ev, $x, $y) = @_;
2234		2359
…		…
2238	my (undef, $lo, $hi, $page) = @{$self->{range}};	2363	my (undef, $lo, $hi, $page) = @{$self->{range}};
2239		2364
2240	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2365	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2241		2366
2242	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2367	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2368	} else {
		2369	return 0;
		2370	}
		2371
2243	}	2372	1
2244	}	2373	}
2245		2374
2246	sub update {	2375	sub update {
2247	my ($self) = @_;	2376	my ($self) = @_;
2248		2377
2249	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2378	delete $self->{knob_w};
		2379	$self->SUPER::update;
		2380	}
		2381
		2382	sub _draw {
		2383	my ($self) = @_;
		2384
		2385	unless ($self->{knob_w}) {
2250	$self->set_value ($self->{range}[0]);	2386	$self->set_value ($self->{range}[0]);
2251		2387
2252	my ($value, $lo, $hi, $page) = @{$self->{range}};	2388	my ($value, $lo, $hi, $page) = @{$self->{range}};
2253	my $range = ($hi - $page - $lo) || 1e-100;	2389	my $range = ($hi - $page - $lo) || 1e-100;
2254		2390
…		…
2260	$value = ($value - $lo) / $range;	2396	$value = ($value - $lo) / $range;
2261	$value = $value * $self->{scale} + $self->{offset};	2397	$value = $value * $self->{scale} + $self->{offset};
2262		2398
2263	$self->{knob_x} = $value - $knob_w * 0.5;	2399	$self->{knob_x} = $value - $knob_w * 0.5;
2264	$self->{knob_w} = $knob_w;	2400	$self->{knob_w} = $knob_w;
2265	});	2401	}
2266
2267	$self->SUPER::update;
2268	}
2269
2270	sub _draw {
2271	my ($self) = @_;
2272		2402
2273	$self->SUPER::_draw ();	2403	$self->SUPER::_draw ();
2274		2404
2275	glScale $self->{w}, $self->{h};	2405	glScale $self->{w}, $self->{h};
2276		2406
…		…
2337	sub set_range { shift->{slider}->set_range (@_) }	2467	sub set_range { shift->{slider}->set_range (@_) }
2338	sub set_value { shift->{slider}->set_value (@_) }	2468	sub set_value { shift->{slider}->set_value (@_) }
2339		2469
2340	#############################################################################	2470	#############################################################################
2341		2471
2342	package CFClient::UI::TextView;	2472	package CFClient::UI::TextScroller;
2343		2473
2344	our @ISA = CFClient::UI::HBox::;	2474	our @ISA = CFClient::UI::HBox::;
2345		2475
2346	use CFClient::OpenGL;	2476	use CFClient::OpenGL;
2347		2477
…		…
2349	my $class = shift;	2479	my $class = shift;
2350		2480
2351	my $self = $class->SUPER::new (	2481	my $self = $class->SUPER::new (
2352	fontsize => 1,	2482	fontsize => 1,
2353	can_events => 0,	2483	can_events => 0,
		2484	indent => 0,
2354	#font => default_font	2485	#font => default_font
2355	@_,	2486	@_,
2356		2487
2357	layout => (new CFClient::Layout 1),	2488	layout => (new CFClient::Layout 1),
2358	par => [],	2489	par => [],
…		…
2374	$self->{fontsize} = $fontsize;	2505	$self->{fontsize} = $fontsize;
2375	$self->reflow;	2506	$self->reflow;
2376	}	2507	}
2377		2508
2378	sub size_allocate {	2509	sub size_allocate {
2379	my ($self, $w, $h, $changed) = @_;	2510	my ($self, $w, $h) = @_;
2380		2511
2381	$self->SUPER::size_allocate ($w, $h, $changed);	2512	$self->SUPER::size_allocate ($w, $h);
2382
2383	return unless $changed;
2384		2513
2385	$self->{layout}->set_font ($self->{font}) if $self->{font};	2514	$self->{layout}->set_font ($self->{font}) if $self->{font};
2386	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2515	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2387	$self->{layout}->set_width ($self->{children}[0]{w});	2516	$self->{layout}->set_width ($self->{children}[0]{w});
		2517	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2388		2518
2389	$self->reflow;	2519	$self->reflow;
2390	}	2520	}
2391		2521
2392	sub text_size {	2522	sub text_size {
…		…
2394		2524
2395	my $layout = $self->{layout};	2525	my $layout = $self->{layout};
2396		2526
2397	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2527	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2398	$layout->set_width ($self->{children}[0]{w} - $indent);	2528	$layout->set_width ($self->{children}[0]{w} - $indent);
		2529	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2399	$layout->set_markup ($text);	2530	$layout->set_markup ($text);
2400		2531
2401	$layout->size	2532	$layout->size
2402	}	2533	}
2403		2534
…		…
2442		2573
2443	return unless $self->{h} > 0;	2574	return unless $self->{h} > 0;
2444		2575
2445	delete $self->{texture};	2576	delete $self->{texture};
2446		2577
2447	$ROOT->on_post_alloc ($self, sub {	2578	$ROOT->on_post_alloc ($self => sub {
2448	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2579	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2449		2580
2450	if (delete $self->{need_reflow}) {	2581	if (delete $self->{need_reflow}) {
2451	my $height = 0;	2582	my $height = 0;
2452		2583
…		…
2455	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2586	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2456		2587
2457	for (@{$self->{par}}) {	2588	for (@{$self->{par}}) {
2458	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2589	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2459	$layout->set_width ($W - $_->[3]);	2590	$layout->set_width ($W - $_->[3]);
		2591	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2460	$layout->set_markup ($_->[4]);	2592	$layout->set_markup ($_->[4]);
2461	my ($w, $h) = $layout->size;	2593	my ($w, $h) = $layout->size;
2462	$_->[0] = $w + $_->[3];	2594	$_->[0] = $w + $_->[3];
2463	$_->[1] = $h;	2595	$_->[1] = $h;
2464	}	2596	}
…		…
2467	}	2599	}
2468		2600
2469	$self->{height} = $height;	2601	$self->{height} = $height;
2470		2602
2471	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2603	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2472		2604
2473	delete $self->{texture};	2605	delete $self->{texture};
2474	}	2606	}
2475		2607
2476	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2608	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2477	glClearColor 0.5, 0.5, 0.5, 0;	2609	glClearColor 0, 0, 0, 0;
2478	glClear GL_COLOR_BUFFER_BIT;	2610	glClear GL_COLOR_BUFFER_BIT;
2479		2611
2480	my $top = int $self->{children}[1]{range}[0];	2612	my $top = int $self->{children}[1]{range}[0];
2481		2613
2482	my $y0 = $top;	2614	my $y0 = $top;
…		…
2496	my $h = $par->[1];	2628	my $h = $par->[1];
2497		2629
2498	if ($y0 < $y + $h && $y < $y1) {	2630	if ($y0 < $y + $h && $y < $y1) {
2499	$layout->set_foreground (@{ $par->[2] });	2631	$layout->set_foreground (@{ $par->[2] });
2500	$layout->set_width ($W - $par->[3]);	2632	$layout->set_width ($W - $par->[3]);
		2633	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2501	$layout->set_markup ($par->[4]);	2634	$layout->set_markup ($par->[4]);
2502		2635
2503	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2636	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2504		2637
2505	glRasterPos $par->[3], $y - $y0;	2638	glRasterPos $par->[3], $y - $y0;
…		…
2517	sub _draw {	2650	sub _draw {
2518	my ($self) = @_;	2651	my ($self) = @_;
2519		2652
2520	glEnable GL_TEXTURE_2D;	2653	glEnable GL_TEXTURE_2D;
2521	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2654	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2522	glColor 1, 1, 1, 1;	2655	glColor 0, 0, 0, 1;
2523	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2656	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2524	glDisable GL_TEXTURE_2D;	2657	glDisable GL_TEXTURE_2D;
2525		2658
2526	$self->{children}[1]->draw;	2659	$self->{children}[1]->draw;
2527		2660
2528	}	2661	}
…		…
2611	}	2744	}
2612		2745
2613	sub set_tooltip_from {	2746	sub set_tooltip_from {
2614	my ($self, $widget) = @_;	2747	my ($self, $widget) = @_;
2615		2748
		2749	my $tooltip = $widget->{tooltip};
		2750
		2751	if ($ENV{CFPLUS_DEBUG} & 2) {
		2752	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2753	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2754	. "req $widget->{req_w} $widget->{req_h}\n"
		2755	. "visible $widget->{visible}";
		2756	}
		2757
		2758	$tooltip =~ s/^\n+//;
		2759	$tooltip =~ s/\n+$//;
		2760
2616	$self->add (new CFClient::UI::Label	2761	$self->add (new CFClient::UI::Label
2617	markup => $widget->{tooltip},	2762	markup => $tooltip,
2618	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2763	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2619	fontsize => 0.8,	2764	fontsize => 0.8,
2620	fg => [0, 0, 0, 1],	2765	fg => [0, 0, 0, 1],
2621	ellipsise => 0,	2766	ellipsise => 0,
2622	font => ($widget->{tooltip_font} || $::FONT_PROP),	2767	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2630		2775
2631	($w + 4, $h + 4)	2776	($w + 4, $h + 4)
2632	}	2777	}
2633		2778
2634	sub size_allocate {	2779	sub size_allocate {
2635	my ($self, $w, $h, $changed) = @_;	2780	my ($self, $w, $h) = @_;
2636		2781
2637	return unless $changed;
2638
2639	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2782	$self->SUPER::size_allocate ($w - 4, $h - 4);
2640	}	2783	}
2641		2784
2642	sub visibility_change {	2785	sub visibility_change {
2643	my ($self, $visible) = @_;	2786	my ($self, $visible) = @_;
2644		2787
…		…
2649	or return;	2792	or return;
2650		2793
2651	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2794	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2652		2795
2653	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2796	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2654	if $x + $self->{w} > $::WIDTH;	2797	if $x + $self->{w} > $self->{root}{w};
2655		2798
2656	$self->move_abs ($x, $y);	2799	$self->move_abs ($x, $y);
2657	});	2800	});
2658	}	2801	}
2659		2802
…		…
2748	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2891	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2749		2892
2750	if ($tex) {	2893	if ($tex) {
2751	glEnable GL_TEXTURE_2D;	2894	glEnable GL_TEXTURE_2D;
2752	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2895	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2753	glColor 1, 1, 1, 1;	2896	glColor 0, 0, 0, 1;
2754	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2897	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2755	glDisable GL_TEXTURE_2D;	2898	glDisable GL_TEXTURE_2D;
2756	}	2899	}
2757	}	2900	}
2758		2901
…		…
2765	$self->SUPER::DESTROY;	2908	$self->SUPER::DESTROY;
2766	}	2909	}
2767		2910
2768	#############################################################################	2911	#############################################################################
2769		2912
2770	package CFClient::UI::Inventory;	2913	package CFClient::UI::Buttonbar;
2771		2914
2772	our @ISA = CFClient::UI::ScrolledWindow::;	2915	our @ISA = CFClient::UI::HBox::;
2773		2916
2774	sub new {	2917	# 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		2918
2810	#############################################################################	2919	#############################################################################
2811		2920
2812	package CFClient::UI::Menu;	2921	package CFClient::UI::Menu;
2813		2922
…		…
2825	);	2934	);
2826		2935
2827	$self->add ($self->{vbox} = new CFClient::UI::VBox);	2936	$self->add ($self->{vbox} = new CFClient::UI::VBox);
2828		2937
2829	for my $item (@{ $self->{items} }) {	2938	for my $item (@{ $self->{items} }) {
2830	my ($widget, $cb) = @$item;	2939	my ($widget, $cb, $tooltip) = @$item;
2831		2940
2832	# handle various types of items, only text for now	2941	# handle various types of items, only text for now
2833	if (!ref $widget) {	2942	if (!ref $widget) {
2834	$widget = new CFClient::UI::Label	2943	$widget = new CFClient::UI::Label
2835	can_hover => 1,	2944	can_hover => 1,
2836	can_events => 1,	2945	can_events => 1,
2837	text => $widget;	2946	markup => $widget,
		2947	tooltip => $tooltip
2838	}	2948	}
2839		2949
2840	$self->{item}{$widget} = $item;	2950	$self->{item}{$widget} = $item;
2841		2951
2842	$self->{vbox}->add ($widget);	2952	$self->{vbox}->add ($widget);
…		…
2854	# maybe save $GRAB? must be careful about events...	2964	# maybe save $GRAB? must be careful about events...
2855	$GRAB = $self;	2965	$GRAB = $self;
2856	$self->{button} = $ev->{button};	2966	$self->{button} = $ev->{button};
2857		2967
2858	$self->show;	2968	$self->show;
2859	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2969	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2860	}	2970	}
2861		2971
2862	sub mouse_motion {	2972	sub mouse_motion {
2863	my ($self, $ev, $x, $y) = @_;	2973	my ($self, $ev, $x, $y) = @_;
2864		2974
2865	# TODO: should use vbox->find_widget or so	2975	# TODO: should use vbox->find_widget or so
2866	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2976	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2867	$self->{hover} = $self->{item}{$HOVER};	2977	$self->{hover} = $self->{item}{$HOVER};
		2978
		2979	0
2868	}	2980	}
2869		2981
2870	sub button_up {	2982	sub button_up {
2871	my ($self, $ev, $x, $y) = @_;	2983	my ($self, $ev, $x, $y) = @_;
2872		2984
…		…
2874	undef $GRAB;	2986	undef $GRAB;
2875	$self->hide;	2987	$self->hide;
2876		2988
2877	$self->_emit ("popdown");	2989	$self->_emit ("popdown");
2878	$self->{hover}[1]->() if $self->{hover};	2990	$self->{hover}[1]->() if $self->{hover};
		2991	} else {
		2992	return 0
		2993	}
		2994
2879	}	2995	1
2880	}	2996	}
2881		2997
2882	#############################################################################	2998	#############################################################################
2883		2999
2884	package CFClient::UI::Statusbox;	3000	package CFClient::UI::Multiplexer;
2885		3001
2886	our @ISA = CFClient::UI::VBox::;	3002	our @ISA = CFClient::UI::Container::;
2887		3003
2888	sub new {	3004	sub new {
2889	my $class = shift;	3005	my $class = shift;
2890		3006
2891	$class->SUPER::new (	3007	my $self = $class->SUPER::new (
		3008	@_,
		3009	);
		3010
		3011	$self->{current} = $self->{children}[0]
		3012	if @{ $self->{children} };
		3013
		3014	$self
		3015	}
		3016
		3017	sub add {
		3018	my ($self, @widgets) = @_;
		3019
		3020	$self->SUPER::add (@widgets);
		3021
		3022	$self->{current} = $self->{children}[0]
		3023	if @{ $self->{children} };
		3024	}
		3025
		3026	sub set_current_page {
		3027	my ($self, $page_or_widget) = @_;
		3028
		3029	my $widget = ref $page_or_widget
		3030	? $page_or_widget
		3031	: $self->{children}[$page_or_widget];
		3032
		3033	$self->{current} = $widget;
		3034	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3035
		3036	$self->_emit (page_changed => $self->{current});
		3037
		3038	$self->realloc;
		3039	}
		3040
		3041	sub visible_children {
		3042	$_[0]{current}
		3043	}
		3044
		3045	sub size_request {
		3046	my ($self) = @_;
		3047
		3048	$self->{current}->size_request
		3049	}
		3050
		3051	sub size_allocate {
		3052	my ($self, $w, $h) = @_;
		3053
		3054	$self->{current}->configure (0, 0, $w, $h);
		3055	}
		3056
		3057	sub _draw {
		3058	my ($self) = @_;
		3059
		3060	$self->{current}->draw;
		3061	}
		3062
		3063	#############################################################################
		3064
		3065	package CFClient::UI::Notebook;
		3066
		3067	our @ISA = CFClient::UI::VBox::;
		3068
		3069	sub new {
		3070	my $class = shift;
		3071
		3072	my $self = $class->SUPER::new (
		3073	buttonbar => (new CFClient::UI::Buttonbar),
		3074	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3075	# filter => # will be put between multiplexer and $self
		3076	@_,
		3077	);
		3078
		3079	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3080	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3081
		3082	$self
		3083	}
		3084
		3085	sub add {
		3086	my ($self, $title, $widget, $tooltip) = @_;
		3087
		3088	Scalar::Util::weaken $self;
		3089
		3090	$self->{buttonbar}->add (new CFClient::UI::Button
		3091	markup => $title,
		3092	tooltip => $tooltip,
		3093	on_activate => sub { $self->set_current_page ($widget) },
		3094	);
		3095
		3096	$self->{multiplexer}->add ($widget);
		3097	}
		3098
		3099	sub set_current_page {
		3100	my ($self, $page) = @_;
		3101
		3102	$self->{multiplexer}->set_current_page ($page);
		3103	$self->_emit (page_changed => $self->{multiplexer}{current});
		3104	}
		3105
		3106	#############################################################################
		3107
		3108	package CFClient::UI::Combobox;
		3109
		3110	use utf8;
		3111
		3112	our @ISA = CFClient::UI::Button::;
		3113
		3114	sub new {
		3115	my $class = shift;
		3116
		3117	my $self = $class->SUPER::new (
		3118	options => [], # [value, title, longdesc], ...
		3119	value => undef,
		3120	@_,
		3121	);
		3122
		3123	$self->_set_value ($self->{value});
		3124
		3125	$self
		3126	}
		3127
		3128	sub button_down {
		3129	my ($self, $ev) = @_;
		3130
		3131	my @menu_items;
		3132
		3133	for (@{ $self->{options} }) {
		3134	my ($value, $title, $tooltip) = @$_;
		3135
		3136	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3137	}
		3138
		3139	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3140	}
		3141
		3142	sub _set_value {
		3143	my ($self, $value) = @_;
		3144
		3145	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3146	or return;
		3147
		3148	$self->{value} = $item->[0];
		3149	$self->set_markup ("$item->[1] ⇓");
		3150	$self->set_tooltip ($item->[2]);
		3151	}
		3152
		3153	sub set_value {
		3154	my ($self, $value) = @_;
		3155
		3156	return unless $self->{value} ne $value;
		3157
		3158	$self->_set_value ($value);
		3159	$self->_emit (changed => $value);
		3160	}
		3161
		3162	#############################################################################
		3163
		3164	package CFClient::UI::Statusbox;
		3165
		3166	our @ISA = CFClient::UI::VBox::;
		3167
		3168	sub new {
		3169	my $class = shift;
		3170
		3171	my $self = $class->SUPER::new (
2892	fontsize => 0.8,	3172	fontsize => 0.8,
2893	@_,	3173	@_,
2894	)	3174	);
		3175
		3176	Scalar::Util::weaken (my $this = $self);
		3177
		3178	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3179
		3180	$self
2895	}	3181	}
2896		3182
2897	sub reorder {	3183	sub reorder {
2898	my ($self) = @_;	3184	my ($self) = @_;
2899	my $NOW = time;	3185	my $NOW = Time::HiRes::time;
		3186
		3187	# freeze display when hovering over any label
		3188	return if $CFClient::UI::TOOLTIP->{owner}
		3189	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3190	values %{ $self->{item} };
2900		3191
2901	while (my ($k, $v) = each %{ $self->{item} }) {	3192	while (my ($k, $v) = each %{ $self->{item} }) {
2902	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3193	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2903	}	3194	}
2904		3195
…		…
2907	my @items = sort {	3198	my @items = sort {
2908	$a->{pri} <=> $b->{pri}	3199	$a->{pri} <=> $b->{pri}
2909	or $b->{id} <=> $a->{id}	3200	or $b->{id} <=> $a->{id}
2910	} values %{ $self->{item} };	3201	} values %{ $self->{item} };
2911		3202
		3203	$self->{timer}->interval (1);
		3204
2912	my $count = 10 + 1;	3205	my $count = 10 + 1;
2913	for my $item (@items) {	3206	for my $item (@items) {
2914	last unless --$count;	3207	last unless --$count;
2915		3208
2916	push @widgets, $item->{label} ||= do {	3209	my $label = $item->{label} ||= do {
2917	# TODO: doesn't handle markup well (read as: at all)	3210	# TODO: doesn't handle markup well (read as: at all)
2918	my $short = $item->{count} > 1	3211	my $short = $item->{count} > 1
2919	? "<b>$item->{count} ×</b> $item->{text}"	3212	? "<b>$item->{count} ×</b> $item->{text}"
2920	: $item->{text};	3213	: $item->{text};
2921		3214
…		…
2929	tooltip => $item->{tooltip},	3222	tooltip => $item->{tooltip},
2930	tooltip_font => $::FONT_PROP,	3223	tooltip_font => $::FONT_PROP,
2931	tooltip_width => 0.67,	3224	tooltip_width => 0.67,
2932	fontsize => $item->{fontsize} || $self->{fontsize},	3225	fontsize => $item->{fontsize} || $self->{fontsize},
2933	max_w => $::WIDTH * 0.44,	3226	max_w => $::WIDTH * 0.44,
2934	fg => $item->{fg},	3227	fg => [@{ $item->{fg} }],
2935	can_events => 1,	3228	can_events => 1,
2936	can_hover => 1	3229	can_hover => 1
2937	};	3230	};
		3231
		3232	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3233	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3234	$label->update;
		3235	$label->set_max_size (undef, $label->{req_h} * $diff)
		3236	if $diff < 1;
		3237	$self->{timer}->interval (1/30);
		3238	} else {
		3239	$label->{fg}[3] = $item->{fg}[3] || 1;
		3240	}
		3241
		3242	push @widgets, $label;
2938	}	3243	}
2939		3244
2940	$self->clear;	3245	$self->clear;
2941	$self->SUPER::add (reverse @widgets);	3246	$self->SUPER::add (reverse @widgets);
2942	}	3247	}
…		…
2947	$text =~ s/^\s+//;	3252	$text =~ s/^\s+//;
2948	$text =~ s/\s+$//;	3253	$text =~ s/\s+$//;
2949		3254
2950	return unless $text;	3255	return unless $text;
2951		3256
2952	my $timeout = time + ((delete $arg{timeout}) || 60);	3257	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2953		3258
2954	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3259	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2955		3260
2956	if (my $item = $self->{item}{$group}) {	3261	if (my $item = $self->{item}{$group}) {
2957	if ($item->{text} eq $text) {	3262	if ($item->{text} eq $text) {
2958	$item->{count}++;	3263	$item->{count}++;
2959	} else {	3264	} else {
2960	$item->{count} = 1;	3265	$item->{count} = 1;
2961	$item->{text} = $item->{tooltip} = $text;	3266	$item->{text} = $item->{tooltip} = $text;
2962	}	3267	}
2963	$item->{id} = ++$self->{id};	3268	$item->{id} += 0.2;#d#
2964	$item->{timeout} = $timeout;	3269	$item->{timeout} = $timeout;
2965	delete $item->{label};	3270	delete $item->{label};
2966	} else {	3271	} else {
2967	$self->{item}{$group} = {	3272	$self->{item}{$group} = {
2968	id => ++$self->{id},	3273	id => ++$self->{id},
…		…
2987		3292
2988	$self->reorder;	3293	$self->reorder;
2989	$self->SUPER::reconfigure;	3294	$self->SUPER::reconfigure;
2990	}	3295	}
2991		3296
		3297	sub DESTROY {
		3298	my ($self) = @_;
		3299
		3300	$self->{timer}->cancel;
		3301
		3302	$self->SUPER::DESTROY;
		3303	}
		3304
2992	#############################################################################	3305	#############################################################################
2993		3306
		3307	package CFClient::UI::Inventory;
		3308
		3309	our @ISA = CFClient::UI::ScrolledWindow::;
		3310
		3311	sub new {
		3312	my $class = shift;
		3313
		3314	my $self = $class->SUPER::new (
		3315	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3316	@_,
		3317	);
		3318
		3319	$self
		3320	}
		3321
		3322	sub set_items {
		3323	my ($self, $items) = @_;
		3324
		3325	$self->{child}->clear;
		3326	return unless $items;
		3327
		3328	my @items = sort {
		3329	($a->{type} <=> $b->{type})
		3330	or ($a->{name} cmp $b->{name})
		3331	} @$items;
		3332
		3333	$self->{real_items} = \@items;
		3334
		3335	my $row = 0;
		3336	for my $item (@items) {
		3337	CFClient::Item::update_widgets $item;
		3338
		3339	$self->{child}->add (0, $row, $item->{face_widget});
		3340	$self->{child}->add (1, $row, $item->{desc_widget});
		3341	$self->{child}->add (2, $row, $item->{weight_widget});
		3342
		3343	$row++;
		3344	}
		3345	}
		3346
		3347	#############################################################################
		3348
		3349	package CFClient::UI::BindEditor;
		3350
		3351	our @ISA = CFClient::UI::FancyFrame::;
		3352
		3353	sub new {
		3354	my $class = shift;
		3355
		3356	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3357
		3358	$self->add (my $vb = new CFClient::UI::VBox);
		3359
		3360
		3361	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3362	text => "start recording",
		3363	tooltip => "Start/Stops recording of actions."
		3364	."All subsequent actions after the recording started will be captured."
		3365	."The actions are displayed after the record was stopped."
		3366	."To bind the action you have to click on the 'Bind' button",
		3367	on_activate => sub {
		3368	unless ($self->{recording}) {
		3369	$self->start;
		3370	} else {
		3371	$self->stop;
		3372	}
		3373	});
		3374
		3375	$vb->add (new CFClient::UI::Label text => "Actions:");
		3376	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3377
		3378	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3379	$vb->add (my $hb = new CFClient::UI::HBox);
		3380	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3381	$hb->add (new CFClient::UI::Button
		3382	text => "bind",
		3383	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3384	on_activate => sub {
		3385	$self->ask_for_bind;
		3386	});
		3387
		3388	$vb->add (my $hb = new CFClient::UI::HBox);
		3389	$hb->add (new CFClient::UI::Button
		3390	text => "ok",
		3391	expand => 1,
		3392	tooltip => "This closes the binding editor and saves the binding",
		3393	on_activate => sub {
		3394	$self->hide;
		3395	$self->commit;
		3396	});
		3397
		3398	$hb->add (new CFClient::UI::Button
		3399	text => "cancel",
		3400	expand => 1,
		3401	tooltip => "This closes the binding editor without saving",
		3402	on_activate => sub {
		3403	$self->hide;
		3404	$self->{binding_cancel}->()
		3405	if $self->{binding_cancel};
		3406	});
		3407
		3408	$self->update_binding_widgets;
		3409
		3410	$self
		3411	}
		3412
		3413	sub commit {
		3414	my ($self) = @_;
		3415	my ($mod, $sym, $cmds) = $self->get_binding;
		3416	if ($sym != 0 && @$cmds > 0) {
		3417	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3418	."'. Don't forget 'Save Config'!");
		3419	$self->{binding_change}->($mod, $sym, $cmds)
		3420	if $self->{binding_change};
		3421	} else {
		3422	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3423	$self->{binding_cancel}->()
		3424	if $self->{binding_cancel};
		3425	}
		3426	}
		3427
		3428	sub start {
		3429	my ($self) = @_;
		3430
		3431	$self->{rec_btn}->set_text ("stop recording");
		3432	$self->{recording} = 1;
		3433	$self->clear_command_list;
		3434	$::CONN->start_record if $::CONN;
		3435	}
		3436
		3437	sub stop {
		3438	my ($self) = @_;
		3439
		3440	$self->{rec_btn}->set_text ("start recording");
		3441	$self->{recording} = 0;
		3442
		3443	my $rec;
		3444	$rec = $::CONN->stop_record if $::CONN;
		3445	return unless ref $rec eq 'ARRAY';
		3446	$self->set_command_list ($rec);
		3447	}
		3448
		3449
		3450	sub ask_for_bind_and_commit {
		3451	my ($self) = @_;
		3452	$self->ask_for_bind (1);
		3453	}
		3454
		3455	sub ask_for_bind {
		3456	my ($self, $commit) = @_;
		3457
		3458	CFClient::Binder::open_binding_dialog (sub {
		3459	my ($mod, $sym) = @_;
		3460	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3461	$self->update_binding_widgets;
		3462	$self->commit if $commit;
		3463	});
		3464	}
		3465
		3466	# $mod and $sym are the modifiers and key symbol
		3467	# $cmds is a array ref of strings (the commands)
		3468	# $cb is the callback that is executed on OK
		3469	# $ccb is the callback that is executed on CANCEL and
		3470	# when the binding was unsuccessful on OK
		3471	sub set_binding {
		3472	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3473
		3474	$self->clear_command_list;
		3475	$self->{recording} = 0;
		3476	$self->{rec_btn}->set_text ("start recording");
		3477
		3478	$self->{binding} = [$mod, $sym];
		3479	$self->{commands} = $cmds;
		3480
		3481	$self->{binding_change} = $cb;
		3482	$self->{binding_cancel} = $ccb;
		3483
		3484	$self->update_binding_widgets;
		3485	}
		3486
		3487	# this is a shortcut method that asks for a binding
		3488	# and then just binds it.
		3489	sub do_quick_binding {
		3490	my ($self, $cmds) = @_;
		3491	$self->set_binding (undef, undef, $cmds, sub {
		3492	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3493	});
		3494	$self->ask_for_bind (1);
		3495	}
		3496
		3497	sub update_binding_widgets {
		3498	my ($self) = @_;
		3499	my ($mod, $sym, $cmds) = $self->get_binding;
		3500	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3501	$self->set_command_list ($cmds);
		3502	}
		3503
		3504	sub get_binding {
		3505	my ($self) = @_;
		3506	return (
		3507	$self->{binding}->[0],
		3508	$self->{binding}->[1],
		3509	[ grep { defined $_ } @{$self->{commands}} ]
		3510	);
		3511	}
		3512
		3513	sub clear_command_list {
		3514	my ($self) = @_;
		3515	$self->{cmdbox}->clear ();
		3516	}
		3517
		3518	sub set_command_list {
		3519	my ($self, $cmds) = @_;
		3520
		3521	$self->{cmdbox}->clear ();
		3522	$self->{commands} = $cmds;
		3523
		3524	my $idx = 0;
		3525
		3526	for (@$cmds) {
		3527	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3528
		3529	my $i = $idx;
		3530	$hb->add (new CFClient::UI::Label text => $_);
		3531	$hb->add (new CFClient::UI::Button
		3532	text => "delete",
		3533	tooltip => "Deletes the action from the record",
		3534	on_activate => sub {
		3535	$self->{cmdbox}->remove ($hb);
		3536	$cmds->[$i] = undef;
		3537	});
		3538
		3539
		3540	$idx++
		3541	}
		3542	}
		3543
		3544	#############################################################################
		3545
		3546	package CFClient::UI::SpellList;
		3547
		3548	our @ISA = CFClient::UI::Table::;
		3549
		3550	sub new {
		3551	my $class = shift;
		3552
		3553	my $self = $class->SUPER::new (
		3554	binding => [],
		3555	commands => [],
		3556	@_,
		3557	)
		3558	}
		3559
		3560	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3561
		3562	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3563	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3564	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3565	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3566	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3567	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3568	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3569	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3570	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3571	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3572
		3573	sub rebuild_spell_list {
		3574	my ($self) = @_;
		3575
		3576	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3577	$self->clear;
		3578
		3579	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3580	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3581	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3582	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3583	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3584
		3585	my $row = 0;
		3586
		3587	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3588	my $spell = $self->{spell}{$_};
		3589
		3590	$row++;
		3591
		3592	my $spell_cb = sub {
		3593	my ($widget, $ev) = @_;
		3594
		3595	if ($ev->{button} == 1) {
		3596	$::CONN->user_send ("cast $spell->{name}");
		3597	} elsif ($ev->{button} == 2) {
		3598	$::CONN->user_send ("invoke $spell->{name}");
		3599	} elsif ($ev->{button} == 3) {
		3600	(new CFClient::UI::Menu
		3601	items => [
		3602	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3603	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3604	],
		3605	)->popup ($ev);
		3606	} else {
		3607	return 0;
		3608	}
		3609
		3610	1
		3611	};
		3612
		3613	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3614
		3615	#TODO: add path info to tooltip
		3616	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3617
		3618	$self->add (0, $row, new CFClient::UI::Face
		3619	face => $spell->{face},
		3620	can_hover => 1,
		3621	can_events => 1,
		3622	tooltip => $tooltip,
		3623	on_button_down => $spell_cb,
		3624	);
		3625
		3626	$self->add (1, $row, new CFClient::UI::Label
		3627	expand => 1,
		3628	text => $spell->{name},
		3629	can_hover => 1,
		3630	can_events => 1,
		3631	tooltip => $tooltip,
		3632	on_button_down => $spell_cb,
		3633	);
		3634
		3635	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3636	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3637	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3638	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3639	}
		3640	});
		3641	}
		3642
		3643	sub add_spell {
		3644	my ($self, $spell) = @_;
		3645
		3646	$self->{spell}->{$spell->{name}} = $spell;
		3647	$self->rebuild_spell_list;
		3648	}
		3649
		3650	sub remove_spell {
		3651	my ($self, $spell) = @_;
		3652
		3653	delete $self->{spell}->{$spell->{name}};
		3654	$self->rebuild_spell_list;
		3655	}
		3656
		3657	#############################################################################
		3658
2994	package CFClient::UI::Root;	3659	package CFClient::UI::Root;
2995		3660
2996	our @ISA = CFClient::UI::Container::;	3661	our @ISA = CFClient::UI::Container::;
		3662
		3663	use List::Util qw(min max);
2997		3664
2998	use CFClient::OpenGL;	3665	use CFClient::OpenGL;
2999		3666
3000	sub new {	3667	sub new {
3001	my $class = shift;	3668	my $class = shift;
…		…
3008	Scalar::Util::weaken ($self->{root} = $self);	3675	Scalar::Util::weaken ($self->{root} = $self);
3009		3676
3010	$self	3677	$self
3011	}	3678	}
3012		3679
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 {	3680	sub size_request {
3030	my ($self) = @_;	3681	my ($self) = @_;
3031		3682
3032	($self->{w}, $self->{h})	3683	($self->{w}, $self->{h})
3033	}	3684	}
…		…
3045		3696
3046	int $coord + 0.5	3697	int $coord + 0.5
3047	}	3698	}
3048		3699
3049	sub size_allocate {	3700	sub size_allocate {
3050	my ($self, $w, $h, $changed) = @_;	3701	my ($self, $w, $h) = @_;
3051		3702
3052	for my $child ($self->children) {	3703	for my $child ($self->children) {
3053	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3704	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3054		3705
3055	$X = $child->{force_x} if exists $child->{force_x};	3706	$X = $child->{force_x} if exists $child->{force_x};
…		…
3123	$_->()	3774	$_->()
3124	for values %{delete $self->{refresh_hook}};	3775	for values %{delete $self->{refresh_hook}};
3125	}	3776	}
3126		3777
3127	if ($self->{realloc}) {	3778	if ($self->{realloc}) {
		3779	my %queue;
3128	my @queue;	3780	my @queue;
		3781	my $widget;
3129		3782
		3783	outer:
3130	while () {	3784	while () {
3131	if ($self->{realloc}) {	3785	if (my $realloc = delete $self->{realloc}) {
3132	#TODO use array-of-depth approach	3786	for $widget (values %$realloc) {
		3787	$widget->{visible} or next; # do not resize invisible widgets
3133		3788
3134	@queue = sort { $a->{visible} <=> $b->{visible} }	3789	$queue{$widget+0}++ and next; # duplicates are common
3135	@queue, values %{delete $self->{realloc}};	3790
		3791	push @{ $queue[$widget->{visible}] }, $widget;
		3792	}
3136	}	3793	}
3137		3794
		3795	while () {
		3796	@queue or last outer;
		3797
3138	my $widget = pop @queue || last;	3798	$widget = pop @{ $queue[-1] || [] }
		3799	and last;
		3800
		3801	pop @queue;
		3802	}
3139		3803
3140	$widget->{visible} or last; # do not resize invisible widgets	3804	delete $queue{$widget+0};
3141		3805
3142	my ($w, $h) = $widget->size_request;	3806	my ($w, $h) = $widget->size_request;
3143		3807
3144	my $min_size = $widget->{is_toplevel} ? 16 : 0;	3808	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3809	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3145		3810
3146	$w = List::Util::max $widget->{min_w} || $widget->{is_toplevel} * 16, $w;	3811	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
3147	$h = List::Util::max $widget->{min_h} || $widget->{is_toplevel} * 16, $h;	3812	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3148		3813
3149	$w = $widget->{force_w} if exists $widget->{force_w};	3814	$w = $widget->{force_w} if exists $widget->{force_w};
3150	$h = $widget->{force_h} if exists $widget->{force_h};	3815	$h = $widget->{force_h} if exists $widget->{force_h};
3151		3816
		3817	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3818	|| delete $widget->{force_realloc}) {
3152	$widget->{req_w} = $w;	3819	$widget->{req_w} = $w;
3153	$widget->{req_h} = $h;	3820	$widget->{req_h} = $h;
3154		3821
3155	$self->{size_alloc}{$widget} = [$widget, undef, undef];	3822	$self->{size_alloc}{$widget+0} = $widget;
3156		3823
3157	push @queue, $widget->{parent}	3824	if (my $parent = $widget->{parent}) {
3158	if ($self->{w} != $w || $self->{h} != $h) && $widget->{parent};	3825	$self->{realloc}{$parent+0} = $parent
		3826	unless $queue{$parent+0};
		3827
		3828	$parent->{force_size_alloc} = 1;
		3829	$self->{size_alloc}{$parent+0} = $parent;
		3830	}
		3831	}
		3832
		3833	delete $self->{realloc}{$widget+0};
3159	}	3834	}
3160	}	3835	}
3161		3836
3162	while (my $size_alloc = delete $self->{size_alloc}) {	3837	while (my $size_alloc = delete $self->{size_alloc}) {
3163	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3838	my @queue = sort { $b->{visible} <=> $a->{visible} }
3164	values %$size_alloc;	3839	values %$size_alloc;
3165		3840
3166	while () {	3841	while () {
3167	my ($widget, $w, $h) = @{ pop @queue or last };	3842	my $widget = pop @queue || last;
3168		3843
3169	$w = $widget->{w} || $widget->{req_w} unless defined $w;	3844	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3170	$h = $widget->{h} || $widget->{req_h} unless defined $h;
3171		3845
3172	$w = 0 if $w < 0;	3846	$w = 0 if $w < 0;
3173	$h = 0 if $h < 0;	3847	$h = 0 if $h < 0;
3174		3848
3175	$w = int $w + 0.5;	3849	$w = int $w + 0.5;
3176	$h = int $h + 0.5;	3850	$h = int $h + 0.5;
3177		3851
3178	my $changed = $widget->{w} != $w || $widget->{h} != $h;	3852	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3853	$widget->{old_w} = $widget->{w};
		3854	$widget->{old_h} = $widget->{h};
3179		3855
3180	$widget->{w} = $w;	3856	$widget->{w} = $w;
3181	$widget->{h} = $h;	3857	$widget->{h} = $h;
3182		3858
3183	$widget->emit (size_allocate => $w, $h, $changed);	3859	$widget->emit (size_allocate => $w, $h);
		3860	}
3184	}	3861	}
3185	}	3862	}
3186		3863
3187	while ($self->{post_alloc_hook}) {	3864	while ($self->{post_alloc_hook}) {
3188	$_->()	3865	$_->()
3189	for values %{delete $self->{post_alloc_hook}};	3866	for values %{delete $self->{post_alloc_hook}};
3190	}	3867	}
		3868
3191		3869
3192	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3870	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3193	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3871	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3194	glClear GL_COLOR_BUFFER_BIT;	3872	glClear GL_COLOR_BUFFER_BIT;
3195		3873
…		…
3197	glLoadIdentity;	3875	glLoadIdentity;
3198	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3876	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3199	glMatrixMode GL_MODELVIEW;	3877	glMatrixMode GL_MODELVIEW;
3200	glLoadIdentity;	3878	glLoadIdentity;
3201		3879
		3880	{
		3881	package CFClient::UI::Base;
		3882
		3883	($draw_x, $draw_y, $draw_w, $draw_h) =
		3884	(0, 0, $self->{w}, $self->{h});
		3885	}
		3886
3202	$self->_draw;	3887	$self->_draw;
3203	}	3888	}
3204		3889
3205	#############################################################################	3890	#############################################################################
3206		3891

Diff Legend

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