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.304 by elmex, Tue Jun 13 11:01:04 2006 UTC

…		…
3	use utf8;	3	use utf8;
4	use strict;	4	use strict;
5		5
6	use Scalar::Util ();	6	use Scalar::Util ();
7	use List::Util ();	7	use List::Util ();
		8	use Event;
8		9
9	use CFClient;	10	use CFClient;
10	use CFClient::Texture;	11	use CFClient::Texture;
11		12
12	our ($FOCUS, $HOVER, $GRAB); # various widgets	13	our ($FOCUS, $HOVER, $GRAB); # various widgets
…		…
15	our $ROOT;	16	our $ROOT;
16	our $TOOLTIP;	17	our $TOOLTIP;
17	our $BUTTON_STATE;	18	our $BUTTON_STATE;
18		19
19	our %WIDGET; # all widgets, weak-referenced	20	our %WIDGET; # all widgets, weak-referenced
		21
		22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
		23	if (!$GRAB) {
		24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
		25	if (length $widget->{tooltip}) {
		26	if ($TOOLTIP->{owner} != $widget) {
		27	$TOOLTIP->hide;
		28
		29	$TOOLTIP->{owner} = $widget;
		30
		31	return if $ENV{CFPLUS_DEBUG} & 8;
		32
		33	my $tip = $widget->{tooltip};
		34
		35	$tip = $tip->($widget) if CODE:: eq ref $tip;
		36
		37	$TOOLTIP->set_tooltip_from ($widget);
		38	$TOOLTIP->show;
		39	}
		40
		41	return;
		42	}
		43	}
		44	}
		45
		46	$TOOLTIP->hide;
		47	delete $TOOLTIP->{owner};
		48	});
20		49
21	sub get_layout {	50	sub get_layout {
22	my $layout;	51	my $layout;
23		52
24	for (grep { $_->{name} } values %WIDGET) {	53	for (grep { $_->{name} } values %WIDGET) {
…		…
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) = @_;
…		…
265		272
266	return unless $self->{visible};	273	return unless $self->{visible};
267		274
268	$_->set_invisible for $self->children;	275	$_->set_invisible for $self->children;
269		276
		277	delete $self->{visible};
270	delete $self->{root};	278	delete $self->{root};
271	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
…		…
567		593
568	sub DESTROY {	594	sub DESTROY {
569	my ($self) = @_;	595	my ($self) = @_;
570		596
571	delete $WIDGET{$self+0};	597	delete $WIDGET{$self+0};
572	#$self->deactivate;	598
		599	eval { $self->destroy };
		600	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
573	}	601	}
574		602
575	#############################################################################	603	#############################################################################
576		604
577	package CFClient::UI::DrawBG;	605	package CFClient::UI::DrawBG;
…		…
602		630
603	if ($color && (@$color < 4 || $color->[3])) {	631	if ($color && (@$color < 4 || $color->[3])) {
604	my ($w, $h) = @$self{qw(w h)};	632	my ($w, $h) = @$self{qw(w h)};
605		633
606	glEnable GL_BLEND;	634	glEnable GL_BLEND;
607	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	635	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
608	glColor @$color;	636	glColor_premultiply @$color;
609		637
610	glBegin GL_QUADS;	638	glBegin GL_QUADS;
611	glVertex 0 , 0;	639	glVertex 0 , 0;
612	glVertex 0 , $h;	640	glVertex 0 , $h;
613	glVertex $w, $h;	641	glVertex $w, $h;
…		…
644	our @ISA = CFClient::UI::Base::;	672	our @ISA = CFClient::UI::Base::;
645		673
646	sub new {	674	sub new {
647	my ($class, %arg) = @_;	675	my ($class, %arg) = @_;
648		676
649	my $children = delete $arg{children} || [];	677	my $children = delete $arg{children};
650		678
651	my $self = $class->SUPER::new (	679	my $self = $class->SUPER::new (
652	children => [],	680	children => [],
653	can_events => 0,	681	can_events => 0,
654	%arg,	682	%arg,
655	);	683	);
		684
656	$self->add ($_) for @$children;	685	$self->add (@$children)
		686	if $children;
657		687
658	$self	688	$self
659	}	689	}
660		690
661	sub add {	691	sub add {
…		…
709	$x -= $self->{x};	739	$x -= $self->{x};
710	$y -= $self->{y};	740	$y -= $self->{y};
711		741
712	my $res;	742	my $res;
713		743
714	for (reverse @{ $self->{children} }) {	744	for (reverse $self->visible_children) {
715	$res = $_->find_widget ($x, $y)	745	$res = $_->find_widget ($x, $y)
716	and return $res;	746	and return $res;
717	}	747	}
718		748
719	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	749	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
740	}	770	}
741		771
742	sub add {	772	sub add {
743	my ($self, $child) = @_;	773	my ($self, $child) = @_;
744		774
745	$self->{children} = [];	775	$self->SUPER::remove ($_) for @{ $self->{children} };
746
747	$self->SUPER::add ($child);	776	$self->SUPER::add ($child);
748	}	777	}
749		778
750	sub remove {	779	sub remove {
751	my ($self, $widget) = @_;	780	my ($self, $widget) = @_;
…		…
761	sub size_request {	790	sub size_request {
762	$_[0]{children}[0]->size_request	791	$_[0]{children}[0]->size_request
763	}	792	}
764		793
765	sub size_allocate {	794	sub size_allocate {
766	my ($self, $w, $h, $changed) = @_;	795	my ($self, $w, $h) = @_;
767		796
768	$self->{children}[0]->configure (0, 0, $w, $h);	797	$self->{children}[0]->configure (0, 0, $w, $h);
769	}	798	}
770		799
771	#############################################################################	800	#############################################################################
		801
		802	# back-buffered drawing area
772		803
773	package CFClient::UI::Window;	804	package CFClient::UI::Window;
774		805
775	our @ISA = CFClient::UI::Bin::;	806	our @ISA = CFClient::UI::Bin::;
776		807
…		…
788	$ROOT->on_post_alloc ($self => sub { $self->render_child });	819	$ROOT->on_post_alloc ($self => sub { $self->render_child });
789	$self->SUPER::update;	820	$self->SUPER::update;
790	}	821	}
791		822
792	sub size_allocate {	823	sub size_allocate {
793	my ($self, $w, $h, $changed) = @_;	824	my ($self, $w, $h) = @_;
794		825
795	$self->SUPER::size_allocate ($w, $h, $changed);	826	$self->SUPER::size_allocate ($w, $h);
796	$self->update	827	$self->update;
797	if $changed;
798	}	828	}
799		829
800	sub _render {	830	sub _render {
		831	my ($self) = @_;
		832
801	$_[0]{children}[0]->draw;	833	$self->{children}[0]->draw;
802	}	834	}
803		835
804	sub render_child {	836	sub render_child {
805	my ($self) = @_;	837	my ($self) = @_;
806		838
807	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	839	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
808	glClearColor 0, 0, 0, 0;	840	glClearColor 0, 0, 0, 0;
809	glClear GL_COLOR_BUFFER_BIT;	841	glClear GL_COLOR_BUFFER_BIT;
810		842
		843	{
		844	package CFClient::UI::Base;
		845
		846	($draw_x, $draw_y, $draw_w, $draw_h) =
		847	(0, 0, $self->{w}, $self->{h});
		848	}
		849
811	$self->_render;	850	$self->_render;
812	};	851	};
813	}	852	}
814		853
815	sub _draw {	854	sub _draw {
816	my ($self) = @_;	855	my ($self) = @_;
817		856
818	my ($w, $h) = ($self->w, $self->h);	857	my ($w, $h) = @$self{qw(w h)};
819		858
820	my $tex = $self->{texture}	859	my $tex = $self->{texture}
821	or return;	860	or return;
822		861
823	glEnable GL_TEXTURE_2D;	862	glEnable GL_TEXTURE_2D;
824	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	863	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
825	glColor 1, 1, 1, 1;	864	glColor 0, 0, 0, 1;
826		865
827	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	866	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
828		867
829	glDisable GL_TEXTURE_2D;	868	glDisable GL_TEXTURE_2D;
830	}	869	}
…		…
846	}	885	}
847		886
848	sub size_request {	887	sub size_request {
849	my ($self) = @_;	888	my ($self) = @_;
850		889
851	my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	890	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
852		891
853	$w = 10 if $self->{scroll_x};	892	$w = 10 if $self->{scroll_x};
854	$h = 10 if $self->{scroll_y};	893	$h = 10 if $self->{scroll_y};
855		894
856	($w, $h)	895	($w, $h)
857	}	896	}
858		897
859	sub size_allocate {	898	sub size_allocate {
860	my ($self, $w, $h, $changed) = @_;	899	my ($self, $w, $h) = @_;
861		900
		901	my $child = $self->child;
		902
862	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	903	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
863	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	904	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
864		905
865	$self->child->configure (0, 0, $w, $h);	906	$self->child->configure (0, 0, $w, $h);
866	$self->update;	907	$self->update;
867	}	908	}
868		909
…		…
904	}	945	}
905		946
906	sub _render {	947	sub _render {
907	my ($self) = @_;	948	my ($self) = @_;
908		949
		950	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		951	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		952
909	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	953	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
910		954
911	$self->SUPER::_render;	955	$self->SUPER::_render;
912	}	956	}
913		957
…		…
916	package CFClient::UI::ScrolledWindow;	960	package CFClient::UI::ScrolledWindow;
917		961
918	our @ISA = CFClient::UI::HBox::;	962	our @ISA = CFClient::UI::HBox::;
919		963
920	sub new {	964	sub new {
921	my $class = shift;	965	my ($class, %arg) = @_;
		966
		967	my $child = delete $arg{child};
922		968
923	my $self;	969	my $self;
924		970
925	my $slider = new CFClient::UI::Slider	971	my $slider = new CFClient::UI::Slider
926	vertical => 1,	972	vertical => 1,
…		…
931	;	977	;
932		978
933	$self = $class->SUPER::new (	979	$self = $class->SUPER::new (
934	vp => (new CFClient::UI::ViewPort expand => 1),	980	vp => (new CFClient::UI::ViewPort expand => 1),
935	slider => $slider,	981	slider => $slider,
936	@_,	982	%arg,
937	);	983	);
938		984
939	$self->{vp}->add ($self->{scrolled});
940	$self->add ($self->{vp});
941	$self->add ($self->{slider});	985	$self->SUPER::add ($self->{vp}, $self->{slider});
		986	$self->add ($child) if $child;
942		987
943	$self	988	$self
		989	}
		990
		991	sub add {
		992	my ($self, $widget) = @_;
		993
		994	$self->{vp}->add ($self->{child} = $widget);
944	}	995	}
945		996
946	sub update {	997	sub update {
947	my ($self) = @_;	998	my ($self) = @_;
948		999
…		…
952	my $child = $self->{vp}->child;	1003	my $child = $self->{vp}->child;
953	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1004	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
954	}	1005	}
955		1006
956	sub size_allocate {	1007	sub size_allocate {
957	my ($self, $w, $h, $changed) = @_;	1008	my ($self, $w, $h) = @_;
958		1009
959	$self->SUPER::size_allocate ($w, $h, $changed);	1010	$self->SUPER::size_allocate ($w, $h);
960		1011
961	my $child = $self->{vp}->child;	1012	my $child = $self->{vp}->child;
962	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1013	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
963	}	1014	}
964		1015
…		…
987		1038
988	if ($self->{bg}) {	1039	if ($self->{bg}) {
989	my ($w, $h) = @$self{qw(w h)};	1040	my ($w, $h) = @$self{qw(w h)};
990		1041
991	glEnable GL_BLEND;	1042	glEnable GL_BLEND;
992	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1043	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
993	glColor @{ $self->{bg} };	1044	glColor_premultiply @{ $self->{bg} };
994		1045
995	glBegin GL_QUADS;	1046	glBegin GL_QUADS;
996	glVertex 0 , 0;	1047	glVertex 0 , 0;
997	glVertex 0 , $h;	1048	glVertex 0 , $h;
998	glVertex $w, $h;	1049	glVertex $w, $h;
…		…
1020	my @border =	1071	my @border =
1021	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1072	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);	1073	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1023		1074
1024	sub new {	1075	sub new {
1025	my $class = shift;	1076	my ($class, %arg) = @_;
1026		1077
1027	my $self = $class->SUPER::new (	1078	my $self = $class->SUPER::new (
1028	bg => [1, 1, 1, 1],	1079	bg => [1, 1, 1, 1],
1029	border_bg => [1, 1, 1, 1],	1080	border_bg => [1, 1, 1, 1],
1030	border => 0.6,	1081	border => 0.6,
1031	can_events => 1,	1082	can_events => 1,
1032	@_	1083	min_w => 16,
		1084	min_h => 16,
		1085	%arg,
1033	);	1086	);
1034		1087
1035	$self->{title} &&= new CFClient::UI::Label	1088	$self->{title_widget} = new CFClient::UI::Label
1036	align => 0,	1089	align => 0,
1037	valign => 1,	1090	valign => 1,
1038	text => $self->{title},	1091	text => $self->{title},
1039	fontsize => $self->{border};	1092	fontsize => $self->{border},
		1093	if exists $self->{title};
		1094
		1095	unless ($self->{no_close_button}) {
		1096	$self->{close_btn} =
		1097	new CFClient::UI::ImageButton
		1098	image => 'x1_close.png',
		1099	on_activate => sub { $self->hide };
		1100
		1101	$self->CFClient::UI::Container::add ($self->{close_btn});
		1102	}
1040		1103
1041	$self	1104	$self
		1105	}
		1106
		1107	sub add {
		1108	my ($self, @widgets) = @_;
		1109
		1110	$self->SUPER::add (@widgets);
		1111	$self->CFClient::UI::Container::add ($self->{close_btn}) if $self->{close_btn};
		1112	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1042	}	1113	}
1043		1114
1044	sub border {	1115	sub border {
1045	int $_[0]{border} * $::FONTSIZE	1116	int $_[0]{border} * $::FONTSIZE
1046	}	1117	}
1047		1118
1048	sub size_request {	1119	sub size_request {
1049	my ($self) = @_;	1120	my ($self) = @_;
		1121
		1122	$self->{title_widget}->size_request
		1123	if $self->{title_widget};
		1124
		1125	$self->{close_btn}->size_request
		1126	if $self->{close_btn};
1050		1127
1051	my ($w, $h) = $self->SUPER::size_request;	1128	my ($w, $h) = $self->SUPER::size_request;
1052		1129
1053	(	1130	(
1054	$w + $self->border * 2,	1131	$w + $self->border * 2,
1055	$h + $self->border * 2,	1132	$h + $self->border * 2,
1056	)	1133	)
1057	}	1134	}
1058		1135
1059	sub size_allocate {	1136	sub size_allocate {
1060	my ($self, $w, $h, $changed) = @_;	1137	my ($self, $w, $h) = @_;
1061		1138
1062	return unless $changed;	1139	if ($self->{title_widget}) {
		1140	$self->{title_widget}{w} = $w;
		1141	$self->{title_widget}{h} = $h;
		1142	$self->{title_widget}->size_allocate ($w, $h);
		1143	}
1063		1144
		1145	my $border = $self->border;
		1146
1064	$h -= List::Util::max 0, $self->border * 2;	1147	$h -= List::Util::max 0, $border * 2;
1065	$w -= List::Util::max 0, $self->border * 2;	1148	$w -= List::Util::max 0, $border * 2;
1066		1149
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);	1150	$self->child->configure ($border, $border, $w, $h);
		1151
		1152	$self->{close_btn}->configure ($self->{w} - (2 * $border), 0, $border, $border)
		1153	if $self->{close_btn};
1071	}	1154	}
1072		1155
1073	sub button_down {	1156	sub button_down {
1074	my ($self, $ev, $x, $y) = @_;	1157	my ($self, $ev, $x, $y) = @_;
1075		1158
…		…
1094	my $dy = $ev->{y} - $oy;	1177	my $dy = $ev->{y} - $oy;
1095		1178
1096	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1179	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1097	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1180	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1098		1181
		1182	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1099	$self->realloc;	1183	$self->realloc;
1100	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1101	};	1184	};
1102		1185
1103	} elsif ($lr ^ $td) {	1186	} elsif ($lr ^ $td) {
1104	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1187	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1105	my ($bx, $by) = ($self->{x}, $self->{y});	1188	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1108	my ($ev, $x, $y) = @_;	1191	my ($ev, $x, $y) = @_;
1109		1192
1110	($x, $y) = ($ev->{x}, $ev->{y});	1193	($x, $y) = ($ev->{x}, $ev->{y});
1111		1194
1112	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1195	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
		1196	# HACK: the next line is required to enforce placement
		1197	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});
1113	};	1198	};
		1199	} else {
		1200	return 0;
		1201	}
		1202
1114	}	1203	1
1115	}	1204	}
1116		1205
1117	sub button_up {	1206	sub button_up {
1118	my ($self, $ev, $x, $y) = @_;	1207	my ($self, $ev, $x, $y) = @_;
1119		1208
		1209	$self->{close_btn}->button_up ($ev, $x, $y)
		1210	if $self->{close_btn};
		1211
1120	delete $self->{motion};	1212	!!delete $self->{motion}
1121	}	1213	}
1122		1214
1123	sub mouse_motion {	1215	sub mouse_motion {
1124	my ($self, $ev, $x, $y) = @_;	1216	my ($self, $ev, $x, $y) = @_;
1125		1217
1126	$self->{motion}->($ev, $x, $y) if $self->{motion};	1218	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1219
		1220	!!$self->{motion}
1127	}	1221	}
1128		1222
1129	sub _draw {	1223	sub _draw {
1130	my ($self) = @_;	1224	my ($self) = @_;
1131		1225
		1226	my $child = $self->{children}[0];
		1227
1132	my ($w, $h ) = ($self->{w}, $self->{h});	1228	my ($w, $h ) = ($self->{w}, $self->{h});
1133	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1229	my ($cw, $ch) = ($child->{w}, $child->{h});
1134		1230
1135	glEnable GL_TEXTURE_2D;	1231	glEnable GL_TEXTURE_2D;
1136	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1232	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1137		1233
1138	my $border = $self->border;	1234	my $border = $self->border;
…		…
1153	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1249	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1154	}	1250	}
1155		1251
1156	glDisable GL_TEXTURE_2D;	1252	glDisable GL_TEXTURE_2D;
1157		1253
1158	$self->{title}->draw if $self->{title};
1159
1160	$self->child->draw;	1254	$child->draw;
		1255
		1256	if ($self->{title_widget}) {
		1257	glTranslate 0, $border - $self->{h};
		1258	$self->{title_widget}->_draw;
		1259
		1260	glTranslate 0, - ($border - $self->{h});
		1261	}
		1262
		1263	$self->{close_btn}->draw
		1264	if $self->{close_btn};
1161	}	1265	}
1162		1266
1163	#############################################################################	1267	#############################################################################
1164		1268
1165	package CFClient::UI::Table;	1269	package CFClient::UI::Table;
…		…
1188		1292
1189	$child->set_parent ($self);	1293	$child->set_parent ($self);
1190	$self->{children}[$y][$x] = $child;	1294	$self->{children}[$y][$x] = $child;
1191		1295
1192	$self->realloc;	1296	$self->realloc;
		1297	}
		1298
		1299	sub remove {
		1300	my ($self, $child) = @_;
		1301
		1302	# TODO: not yet implemented
1193	}	1303	}
1194		1304
1195	# TODO: move to container class maybe? send children a signal on removal?	1305	# TODO: move to container class maybe? send children a signal on removal?
1196	sub clear {	1306	sub clear {
1197	my ($self) = @_;	1307	my ($self) = @_;
…		…
1239	(sum @$hs),	1349	(sum @$hs),
1240	)	1350	)
1241	}	1351	}
1242		1352
1243	sub size_allocate {	1353	sub size_allocate {
1244	my ($self, $w, $h, $changed) = @_;	1354	my ($self, $w, $h) = @_;
1245		1355
1246	my ($ws, $hs) = $self->get_wh;	1356	my ($ws, $hs) = $self->get_wh;
1247		1357
1248	my $req_w = (sum @$ws) || 1;	1358	my $req_w = (sum @$ws) || 1;
1249	my $req_h = (sum @$hs) || 1;	1359	my $req_h = (sum @$hs) || 1;
…		…
1327	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1437	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1328	)	1438	)
1329	}	1439	}
1330		1440
1331	sub size_allocate {	1441	sub size_allocate {
1332	my ($self, $w, $h, $changed) = @_;	1442	my ($self, $w, $h) = @_;
1333		1443
1334	my $space = $self->{vertical} ? $h : $w;	1444	my $space = $self->{vertical} ? $h : $w;
1335	my $children = $self->{children};	1445	my $children = $self->{children};
1336		1446
1337	my @req;	1447	my @req;
…		…
1420	ellipsise => 3, # end	1530	ellipsise => 3, # end
1421	layout => (new CFClient::Layout),	1531	layout => (new CFClient::Layout),
1422	fontsize => 1,	1532	fontsize => 1,
1423	align => -1,	1533	align => -1,
1424	valign => -1,	1534	valign => -1,
1425	padding => 2,	1535	padding_x => 2,
		1536	padding_y => 2,
1426	can_events => 0,	1537	can_events => 0,
1427	%arg	1538	%arg
1428	);	1539	);
1429		1540
1430	if (exists $self->{template}) {	1541	if (exists $self->{template}) {
…		…
1457		1568
1458	delete $self->{texture};	1569	delete $self->{texture};
1459	$self->SUPER::update;	1570	$self->SUPER::update;
1460	}	1571	}
1461		1572
		1573	sub realloc {
		1574	my ($self) = @_;
		1575
		1576	delete $self->{ox};
		1577	$self->SUPER::realloc;
		1578	}
		1579
1462	sub set_text {	1580	sub set_text {
1463	my ($self, $text) = @_;	1581	my ($self, $text) = @_;
1464		1582
1465	return if $self->{text} eq "T$text";	1583	return if $self->{text} eq "T$text";
1466	$self->{text} = "T$text";	1584	$self->{text} = "T$text";
1467		1585
1468	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1586	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1469	$self->{layout}->set_text ($text);	1587	$self->{layout}->set_text ($text);
1470		1588
		1589	delete $self->{size_req};
1471	$self->realloc;	1590	$self->realloc;
1472	$self->update;	1591	$self->update;
1473	}	1592	}
1474		1593
1475	sub set_markup {	1594	sub set_markup {
…		…
1481	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1600	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1482		1601
1483	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1602	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1484	$self->{layout}->set_markup ($markup);	1603	$self->{layout}->set_markup ($markup);
1485		1604
		1605	delete $self->{size_req};
1486	$self->realloc;	1606	$self->realloc;
1487	$self->update;	1607	$self->update;
1488	}	1608	}
1489		1609
1490	sub size_request {	1610	sub size_request {
1491	my ($self) = @_;	1611	my ($self) = @_;
1492		1612
		1613	$self->{size_req} ||= do {
1493	$self->{layout}->set_font ($self->{font}) if $self->{font};	1614	$self->{layout}->set_font ($self->{font}) if $self->{font};
1494	$self->{layout}->set_width ($self->{max_w} || -1);	1615	$self->{layout}->set_width ($self->{max_w} || -1);
1495	$self->{layout}->set_ellipsise ($self->{ellipsise});	1616	$self->{layout}->set_ellipsise ($self->{ellipsise});
1496	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1617	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1497	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1618	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1498		1619
1499	my ($w, $h) = $self->{layout}->size;	1620	my ($w, $h) = $self->{layout}->size;
1500		1621
1501	if (exists $self->{template}) {	1622	if (exists $self->{template}) {
1502	$self->{template}->set_font ($self->{font}) if $self->{font};	1623	$self->{template}->set_font ($self->{font}) if $self->{font};
1503	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1624	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1504		1625
1505	my ($w2, $h2) = $self->{template}->size;	1626	my ($w2, $h2) = $self->{template}->size;
1506		1627
1507	$w = List::Util::max $w, $w2;	1628	$w = List::Util::max $w, $w2;
1508	$h = List::Util::max $h, $h2;	1629	$h = List::Util::max $h, $h2;
		1630	}
		1631
		1632	[$w, $h]
1509	}	1633	};
1510		1634
1511	(	1635	@{ $self->{size_req} }
1512	$w + $self->{padding} * 2,
1513	$h + $self->{padding} * 2,
1514	)
1515	}	1636	}
1516		1637
1517	sub size_allocate {	1638	sub size_allocate {
1518	my ($self, $w, $h, $changed) = @_;	1639	my ($self, $w, $h) = @_;
		1640
		1641	delete $self->{ox};
1519		1642
1520	delete $self->{texture}	1643	delete $self->{texture}
1521	if $changed;	1644	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1522	}	1645	}
1523		1646
1524	sub set_fontsize {	1647	sub set_fontsize {
1525	my ($self, $fontsize) = @_;	1648	my ($self, $fontsize) = @_;
1526		1649
1527	$self->{fontsize} = $fontsize;	1650	$self->{fontsize} = $fontsize;
1528	delete $self->{texture};	1651	delete $self->{texture};
1529		1652
1530	$self->realloc;	1653	$self->realloc;
		1654	}
		1655
		1656	sub reconfigure {
		1657	my ($self) = @_;
		1658
		1659	delete $self->{size_req};
		1660
		1661	$self->SUPER::reconfigure;
1531	}	1662	}
1532		1663
1533	sub _draw {	1664	sub _draw {
1534	my ($self) = @_;	1665	my ($self) = @_;
1535		1666
…		…
1541	$self->{layout}->set_width ($self->{w});	1672	$self->{layout}->set_width ($self->{w});
1542	$self->{layout}->set_ellipsise ($self->{ellipsise});	1673	$self->{layout}->set_ellipsise ($self->{ellipsise});
1543	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1674	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1544	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1675	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1545		1676
1546	my $tex = new_from_layout CFClient::Texture $self->{layout};	1677	new_from_layout CFClient::Texture $self->{layout}
		1678	};
1547		1679
		1680	unless (exists $self->{ox}) {
1548	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1681	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1549	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1682	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1550	: ($self->{w} - $tex->{w}) * 0.5);	1683	: ($self->{w} - $tex->{w}) * 0.5);
1551		1684
1552	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1685	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1553	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1686	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1554	: ($self->{h} - $tex->{h}) * 0.5);	1687	: ($self->{h} - $tex->{h}) * 0.5);
1555
1556	$tex
1557	};	1688	};
1558		1689
1559	glEnable GL_TEXTURE_2D;	1690	glEnable GL_TEXTURE_2D;
1560	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1691
		1692	my $w = List::Util::min $self->{w} + 4, $tex->{w};
		1693	my $h = List::Util::min $self->{h} + 2, $tex->{h};
1561		1694
1562	if ($tex->{format} == GL_ALPHA) {	1695	if ($tex->{format} == GL_ALPHA) {
		1696	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1563	glColor @{$self->{fg}};	1697	glColor @{$self->{fg}};
1564	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1698	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1565	} else {	1699	} else {
		1700	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1566	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1701	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1567	}	1702	}
1568		1703
1569	glDisable GL_TEXTURE_2D;	1704	glDisable GL_TEXTURE_2D;
1570	}	1705	}
1571		1706
…		…
1588	can_hover => 1,	1723	can_hover => 1,
1589	can_focus => 1,	1724	can_focus => 1,
1590	valign => 0,	1725	valign => 0,
1591	can_events => 1,	1726	can_events => 1,
1592	#text => ...	1727	#text => ...
		1728	#hidden => "*",
1593	@_	1729	@_
1594	)	1730	)
1595	}	1731	}
1596		1732
1597	sub _set_text {	1733	sub _set_text {
…		…
1599		1735
1600	delete $self->{cur_h};	1736	delete $self->{cur_h};
1601		1737
1602	return if $self->{text} eq $text;	1738	return if $self->{text} eq $text;
1603		1739
1604	delete $self->{texture};
1605
1606	$self->{last_activity} = $::NOW;	1740	$self->{last_activity} = $::NOW;
1607	$self->{text} = $text;	1741	$self->{text} = $text;
1608		1742
1609	$text =~ s/./*/g if $self->{hidden};	1743	$text =~ s/./*/g if $self->{hidden};
1610	$self->{layout}->set_text ("$text ");	1744	$self->{layout}->set_text ("$text ");
		1745	delete $self->{size_req};
1611		1746
1612	$self->_emit (changed => $self->{text});	1747	$self->_emit (changed => $self->{text});
		1748
		1749	$self->realloc;
		1750	$self->update;
1613	}	1751	}
1614		1752
1615	sub set_text {	1753	sub set_text {
1616	my ($self, $text) = @_;	1754	my ($self, $text) = @_;
1617		1755
1618	$self->{cursor} = length $text;	1756	$self->{cursor} = length $text;
1619	$self->_set_text ($text);	1757	$self->_set_text ($text);
1620
1621	$self->realloc;
1622	}	1758	}
1623		1759
1624	sub get_text {	1760	sub get_text {
1625	$_[0]{text}	1761	$_[0]{text}
1626	}	1762	}
…		…
1656	$self->{cursor} = length $text;	1792	$self->{cursor} = length $text;
1657	} elsif ($uni == 27) {	1793	} elsif ($uni == 27) {
1658	$self->_emit ('escape');	1794	$self->_emit ('escape');
1659	} elsif ($uni) {	1795	} elsif ($uni) {
1660	substr $text, $self->{cursor}++, 0, chr $uni;	1796	substr $text, $self->{cursor}++, 0, chr $uni;
		1797	} else {
		1798	return 0;
1661	}	1799	}
1662		1800
1663	$self->_set_text ($text);	1801	$self->_set_text ($text);
1664		1802
1665	$self->realloc;	1803	$self->realloc;
		1804
		1805	1
1666	}	1806	}
1667		1807
1668	sub focus_in {	1808	sub focus_in {
1669	my ($self) = @_;	1809	my ($self) = @_;
1670		1810
…		…
1685	utf8::encode $text;	1825	utf8::encode $text;
1686	$self->{cursor} = length substr $text, 0, $idx;	1826	$self->{cursor} = length substr $text, 0, $idx;
1687		1827
1688	$self->_set_text ($self->{text});	1828	$self->_set_text ($self->{text});
1689	$self->update;	1829	$self->update;
		1830
		1831	1
1690	}	1832	}
1691		1833
1692	sub mouse_motion {	1834	sub mouse_motion {
1693	my ($self, $ev, $x, $y) = @_;	1835	my ($self, $ev, $x, $y) = @_;
1694	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1836	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1837
		1838	0
1695	}	1839	}
1696		1840
1697	sub _draw {	1841	sub _draw {
1698	my ($self) = @_;	1842	my ($self) = @_;
1699		1843
1700	local $self->{fg} = $self->{fg};	1844	local $self->{fg} = $self->{fg};
1701		1845
1702	if ($FOCUS == $self) {	1846	if ($FOCUS == $self) {
1703	glColor @{$self->{active_bg}};	1847	glColor_premultiply @{$self->{active_bg}};
1704	$self->{fg} = $self->{active_fg};	1848	$self->{fg} = $self->{active_fg};
1705	} else {	1849	} else {
1706	glColor @{$self->{bg}};	1850	glColor_premultiply @{$self->{bg}};
1707	}	1851	}
1708		1852
1709	glEnable GL_BLEND;	1853	glEnable GL_BLEND;
1710	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1854	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1711	glBegin GL_QUADS;	1855	glBegin GL_QUADS;
1712	glVertex 0 , 0;	1856	glVertex 0 , 0;
1713	glVertex 0 , $self->{h};	1857	glVertex 0 , $self->{h};
1714	glVertex $self->{w}, $self->{h};	1858	glVertex $self->{w}, $self->{h};
1715	glVertex $self->{w}, 0;	1859	glVertex $self->{w}, 0;
…		…
1776	} else {	1920	} else {
1777	$self->set_text ($self->{history_saveback});	1921	$self->set_text ($self->{history_saveback});
1778	}	1922	}
1779		1923
1780	} else {	1924	} else {
1781	$self->SUPER::key_down ($ev);	1925	return $self->SUPER::key_down ($ev)
		1926	}
		1927
1782	}	1928	1
1783
1784	}	1929	}
1785		1930
1786	#############################################################################	1931	#############################################################################
1787		1932
1788	package CFClient::UI::Button;	1933	package CFClient::UI::Button;
…		…
1797		1942
1798	sub new {	1943	sub new {
1799	my $class = shift;	1944	my $class = shift;
1800		1945
1801	$class->SUPER::new (	1946	$class->SUPER::new (
1802	padding => 4,	1947	padding_x => 4,
		1948	padding_y => 4,
1803	fg => [1, 1, 1],	1949	fg => [1, 1, 1],
1804	active_fg => [0, 0, 1],	1950	active_fg => [0, 0, 1],
1805	can_hover => 1,	1951	can_hover => 1,
1806	align => 0,	1952	align => 0,
1807	valign => 0,	1953	valign => 0,
…		…
1816	my ($self, $ev, $x, $y) = @_;	1962	my ($self, $ev, $x, $y) = @_;
1817		1963
1818	$self->emit ("activate")	1964	$self->emit ("activate")
1819	if $x >= 0 && $x < $self->{w}	1965	if $x >= 0 && $x < $self->{w}
1820	&& $y >= 0 && $y < $self->{h};	1966	&& $y >= 0 && $y < $self->{h};
		1967
		1968	1
1821	}	1969	}
1822		1970
1823	sub _draw {	1971	sub _draw {
1824	my ($self) = @_;	1972	my ($self) = @_;
1825		1973
1826	local $self->{fg} = $self->{fg};	1974	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1827
1828	if ($GRAB == $self) {
1829	$self->{fg} = $self->{active_fg};
1830	}
1831		1975
1832	glEnable GL_TEXTURE_2D;	1976	glEnable GL_TEXTURE_2D;
1833	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1977	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1834	glColor 0, 0, 0, 1;	1978	glColor 0, 0, 0, 1;
1835		1979
…		…
1840	$self->SUPER::_draw;	1984	$self->SUPER::_draw;
1841	}	1985	}
1842		1986
1843	#############################################################################	1987	#############################################################################
1844		1988
		1989	package CFClient::UI::ImageButton;
		1990
		1991	our @ISA = CFClient::UI::Image::;
		1992
		1993	use CFClient::OpenGL;
		1994
		1995	my %textures;
		1996
		1997	sub new {
		1998	my $class = shift;
		1999
		2000	my $self = $class->SUPER::new (
		2001	padding_x => 4,
		2002	padding_y => 4,
		2003	fg => [1, 1, 1],
		2004	active_fg => [0, 0, 1],
		2005	can_hover => 1,
		2006	align => 0,
		2007	valign => 0,
		2008	can_events => 1,
		2009	@_
		2010	);
		2011	}
		2012
		2013	sub activate { }
		2014
		2015	sub button_up {
		2016	my ($self, $ev, $x, $y) = @_;
		2017
		2018	$self->emit ("activate")
		2019	if $x >= 0 && $x < $self->{w}
		2020	&& $y >= 0 && $y < $self->{h};
		2021
		2022	1
		2023	}
		2024
		2025	#############################################################################
		2026
1845	package CFClient::UI::CheckBox;	2027	package CFClient::UI::CheckBox;
1846		2028
1847	our @ISA = CFClient::UI::DrawBG::;	2029	our @ISA = CFClient::UI::DrawBG::;
1848		2030
1849	my @tex =	2031	my @tex =
…		…
1854		2036
1855	sub new {	2037	sub new {
1856	my $class = shift;	2038	my $class = shift;
1857		2039
1858	$class->SUPER::new (	2040	$class->SUPER::new (
1859	padding => 2,	2041	padding_x => 2,
		2042	padding_y => 2,
1860	fg => [1, 1, 1],	2043	fg => [1, 1, 1],
1861	active_fg => [1, 1, 0],	2044	active_fg => [1, 1, 0],
1862	bg => [0, 0, 0, 0.2],	2045	bg => [0, 0, 0, 0.2],
1863	active_bg => [1, 1, 1, 0.5],	2046	active_bg => [1, 1, 1, 0.5],
1864	state => 0,	2047	state => 0,
…		…
1868	}	2051	}
1869		2052
1870	sub size_request {	2053	sub size_request {
1871	my ($self) = @_;	2054	my ($self) = @_;
1872		2055
1873	($self->{padding} * 2 + 6) x 2	2056	(6) x 2
1874	}	2057	}
1875		2058
1876	sub button_down {	2059	sub button_down {
1877	my ($self, $ev, $x, $y) = @_;	2060	my ($self, $ev, $x, $y) = @_;
1878		2061
1879	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	2062	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1880	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	2063	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1881	$self->{state} = !$self->{state};	2064	$self->{state} = !$self->{state};
1882	$self->_emit (changed => $self->{state});	2065	$self->_emit (changed => $self->{state});
		2066	} else {
		2067	return 0
		2068	}
		2069
1883	}	2070	1
1884	}	2071	}
1885		2072
1886	sub _draw {	2073	sub _draw {
1887	my ($self) = @_;	2074	my ($self) = @_;
1888		2075
1889	$self->SUPER::_draw;	2076	$self->SUPER::_draw;
1890		2077
1891	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	2078	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1892		2079
1893	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	2080	my ($w, $h) = @$self{qw(w h)};
		2081
		2082	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1894		2083
1895	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2084	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1896		2085
1897	my $tex = $self->{state} ? $tex[1] : $tex[0];	2086	my $tex = $self->{state} ? $tex[1] : $tex[0];
1898		2087
…		…
2053		2242
2054	my $h1 = $self->{h} * (1 - $ycut1);	2243	my $h1 = $self->{h} * (1 - $ycut1);
2055	my $h2 = $self->{h} * (1 - $ycut2);	2244	my $h2 = $self->{h} * (1 - $ycut2);
2056		2245
2057	glEnable GL_BLEND;	2246	glEnable GL_BLEND;
2058	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2247	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2248	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2059	glEnable GL_TEXTURE_2D;	2249	glEnable GL_TEXTURE_2D;
2060	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2250	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2061		2251
2062	glBindTexture GL_TEXTURE_2D, $t1->{name};	2252	glBindTexture GL_TEXTURE_2D, $t1->{name};
2063	glBegin GL_QUADS;	2253	glBegin GL_QUADS;
…		…
2184	sub set_range {	2374	sub set_range {
2185	my ($self, $range) = @_;	2375	my ($self, $range) = @_;
2186		2376
2187	($range, $self->{range}) = ($self->{range}, $range);	2377	($range, $self->{range}) = ($self->{range}, $range);
2188		2378
2189	$self->update
2190	if "@$range" ne "@{$self->{range}}";	2379	if ("@$range" ne "@{$self->{range}}") {
		2380	$self->update;
		2381	$self->set_value ($self->{range}[0]);
		2382	}
2191	}	2383	}
2192		2384
2193	sub set_value {	2385	sub set_value {
2194	my ($self, $value) = @_;	2386	my ($self, $value) = @_;
2195		2387
…		…
2224		2416
2225	$self->SUPER::button_down ($ev, $x, $y);	2417	$self->SUPER::button_down ($ev, $x, $y);
2226		2418
2227	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2419	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2228		2420
2229	$self->mouse_motion ($ev, $x, $y);	2421	$self->mouse_motion ($ev, $x, $y)
2230	}	2422	}
2231		2423
2232	sub mouse_motion {	2424	sub mouse_motion {
2233	my ($self, $ev, $x, $y) = @_;	2425	my ($self, $ev, $x, $y) = @_;
2234		2426
…		…
2238	my (undef, $lo, $hi, $page) = @{$self->{range}};	2430	my (undef, $lo, $hi, $page) = @{$self->{range}};
2239		2431
2240	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2432	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2241		2433
2242	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2434	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2435	} else {
		2436	return 0;
		2437	}
		2438
2243	}	2439	1
2244	}	2440	}
2245		2441
2246	sub update {	2442	sub update {
2247	my ($self) = @_;	2443	my ($self) = @_;
2248		2444
2249	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2445	delete $self->{knob_w};
		2446	$self->SUPER::update;
		2447	}
		2448
		2449	sub _draw {
		2450	my ($self) = @_;
		2451
		2452	unless ($self->{knob_w}) {
2250	$self->set_value ($self->{range}[0]);	2453	$self->set_value ($self->{range}[0]);
2251		2454
2252	my ($value, $lo, $hi, $page) = @{$self->{range}};	2455	my ($value, $lo, $hi, $page) = @{$self->{range}};
2253	my $range = ($hi - $page - $lo) || 1e-100;	2456	my $range = ($hi - $page - $lo) || 1e-100;
2254		2457
…		…
2260	$value = ($value - $lo) / $range;	2463	$value = ($value - $lo) / $range;
2261	$value = $value * $self->{scale} + $self->{offset};	2464	$value = $value * $self->{scale} + $self->{offset};
2262		2465
2263	$self->{knob_x} = $value - $knob_w * 0.5;	2466	$self->{knob_x} = $value - $knob_w * 0.5;
2264	$self->{knob_w} = $knob_w;	2467	$self->{knob_w} = $knob_w;
2265	});	2468	}
2266
2267	$self->SUPER::update;
2268	}
2269
2270	sub _draw {
2271	my ($self) = @_;
2272		2469
2273	$self->SUPER::_draw ();	2470	$self->SUPER::_draw ();
2274		2471
2275	glScale $self->{w}, $self->{h};	2472	glScale $self->{w}, $self->{h};
2276		2473
…		…
2337	sub set_range { shift->{slider}->set_range (@_) }	2534	sub set_range { shift->{slider}->set_range (@_) }
2338	sub set_value { shift->{slider}->set_value (@_) }	2535	sub set_value { shift->{slider}->set_value (@_) }
2339		2536
2340	#############################################################################	2537	#############################################################################
2341		2538
2342	package CFClient::UI::TextView;	2539	package CFClient::UI::TextScroller;
2343		2540
2344	our @ISA = CFClient::UI::HBox::;	2541	our @ISA = CFClient::UI::HBox::;
2345		2542
2346	use CFClient::OpenGL;	2543	use CFClient::OpenGL;
2347		2544
…		…
2349	my $class = shift;	2546	my $class = shift;
2350		2547
2351	my $self = $class->SUPER::new (	2548	my $self = $class->SUPER::new (
2352	fontsize => 1,	2549	fontsize => 1,
2353	can_events => 0,	2550	can_events => 0,
		2551	indent => 0,
2354	#font => default_font	2552	#font => default_font
2355	@_,	2553	@_,
2356		2554
2357	layout => (new CFClient::Layout 1),	2555	layout => (new CFClient::Layout 1),
2358	par => [],	2556	par => [],
…		…
2374	$self->{fontsize} = $fontsize;	2572	$self->{fontsize} = $fontsize;
2375	$self->reflow;	2573	$self->reflow;
2376	}	2574	}
2377		2575
2378	sub size_allocate {	2576	sub size_allocate {
2379	my ($self, $w, $h, $changed) = @_;	2577	my ($self, $w, $h) = @_;
2380		2578
2381	$self->SUPER::size_allocate ($w, $h, $changed);	2579	$self->SUPER::size_allocate ($w, $h);
2382
2383	return unless $changed;
2384		2580
2385	$self->{layout}->set_font ($self->{font}) if $self->{font};	2581	$self->{layout}->set_font ($self->{font}) if $self->{font};
2386	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2582	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2387	$self->{layout}->set_width ($self->{children}[0]{w});	2583	$self->{layout}->set_width ($self->{children}[0]{w});
		2584	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2388		2585
2389	$self->reflow;	2586	$self->reflow;
2390	}	2587	}
2391		2588
2392	sub text_size {	2589	sub text_size {
…		…
2394		2591
2395	my $layout = $self->{layout};	2592	my $layout = $self->{layout};
2396		2593
2397	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2594	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2398	$layout->set_width ($self->{children}[0]{w} - $indent);	2595	$layout->set_width ($self->{children}[0]{w} - $indent);
		2596	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2399	$layout->set_markup ($text);	2597	$layout->set_markup ($text);
2400		2598
2401	$layout->size	2599	$layout->size
2402	}	2600	}
2403		2601
…		…
2442		2640
2443	return unless $self->{h} > 0;	2641	return unless $self->{h} > 0;
2444		2642
2445	delete $self->{texture};	2643	delete $self->{texture};
2446		2644
2447	$ROOT->on_post_alloc ($self, sub {	2645	$ROOT->on_post_alloc ($self => sub {
2448	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2646	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2449		2647
2450	if (delete $self->{need_reflow}) {	2648	if (delete $self->{need_reflow}) {
2451	my $height = 0;	2649	my $height = 0;
2452		2650
…		…
2455	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2653	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2456		2654
2457	for (@{$self->{par}}) {	2655	for (@{$self->{par}}) {
2458	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2656	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2459	$layout->set_width ($W - $_->[3]);	2657	$layout->set_width ($W - $_->[3]);
		2658	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2460	$layout->set_markup ($_->[4]);	2659	$layout->set_markup ($_->[4]);
2461	my ($w, $h) = $layout->size;	2660	my ($w, $h) = $layout->size;
2462	$_->[0] = $w + $_->[3];	2661	$_->[0] = $w + $_->[3];
2463	$_->[1] = $h;	2662	$_->[1] = $h;
2464	}	2663	}
…		…
2467	}	2666	}
2468		2667
2469	$self->{height} = $height;	2668	$self->{height} = $height;
2470		2669
2471	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2670	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2472		2671
2473	delete $self->{texture};	2672	delete $self->{texture};
2474	}	2673	}
2475		2674
2476	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2675	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2477	glClearColor 0.5, 0.5, 0.5, 0;	2676	glClearColor 0, 0, 0, 0;
2478	glClear GL_COLOR_BUFFER_BIT;	2677	glClear GL_COLOR_BUFFER_BIT;
2479		2678
2480	my $top = int $self->{children}[1]{range}[0];	2679	my $top = int $self->{children}[1]{range}[0];
2481		2680
2482	my $y0 = $top;	2681	my $y0 = $top;
…		…
2496	my $h = $par->[1];	2695	my $h = $par->[1];
2497		2696
2498	if ($y0 < $y + $h && $y < $y1) {	2697	if ($y0 < $y + $h && $y < $y1) {
2499	$layout->set_foreground (@{ $par->[2] });	2698	$layout->set_foreground (@{ $par->[2] });
2500	$layout->set_width ($W - $par->[3]);	2699	$layout->set_width ($W - $par->[3]);
		2700	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2501	$layout->set_markup ($par->[4]);	2701	$layout->set_markup ($par->[4]);
2502		2702
2503	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2703	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2504		2704
2505	glRasterPos $par->[3], $y - $y0;	2705	glRasterPos $par->[3], $y - $y0;
…		…
2517	sub _draw {	2717	sub _draw {
2518	my ($self) = @_;	2718	my ($self) = @_;
2519		2719
2520	glEnable GL_TEXTURE_2D;	2720	glEnable GL_TEXTURE_2D;
2521	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2721	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2522	glColor 1, 1, 1, 1;	2722	glColor 0, 0, 0, 1;
2523	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2723	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2524	glDisable GL_TEXTURE_2D;	2724	glDisable GL_TEXTURE_2D;
2525		2725
2526	$self->{children}[1]->draw;	2726	$self->{children}[1]->draw;
2527		2727
2528	}	2728	}
…		…
2611	}	2811	}
2612		2812
2613	sub set_tooltip_from {	2813	sub set_tooltip_from {
2614	my ($self, $widget) = @_;	2814	my ($self, $widget) = @_;
2615		2815
		2816	my $tooltip = $widget->{tooltip};
		2817
		2818	if ($ENV{CFPLUS_DEBUG} & 2) {
		2819	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2820	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2821	. "req $widget->{req_w} $widget->{req_h}\n"
		2822	. "visible $widget->{visible}";
		2823	}
		2824
		2825	$tooltip =~ s/^\n+//;
		2826	$tooltip =~ s/\n+$//;
		2827
2616	$self->add (new CFClient::UI::Label	2828	$self->add (new CFClient::UI::Label
2617	markup => $widget->{tooltip},	2829	markup => $tooltip,
2618	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2830	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2619	fontsize => 0.8,	2831	fontsize => 0.8,
2620	fg => [0, 0, 0, 1],	2832	fg => [0, 0, 0, 1],
2621	ellipsise => 0,	2833	ellipsise => 0,
2622	font => ($widget->{tooltip_font} || $::FONT_PROP),	2834	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2630		2842
2631	($w + 4, $h + 4)	2843	($w + 4, $h + 4)
2632	}	2844	}
2633		2845
2634	sub size_allocate {	2846	sub size_allocate {
2635	my ($self, $w, $h, $changed) = @_;	2847	my ($self, $w, $h) = @_;
2636		2848
2637	return unless $changed;
2638
2639	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2849	$self->SUPER::size_allocate ($w - 4, $h - 4);
2640	}	2850	}
2641		2851
2642	sub visibility_change {	2852	sub visibility_change {
2643	my ($self, $visible) = @_;	2853	my ($self, $visible) = @_;
2644		2854
…		…
2649	or return;	2859	or return;
2650		2860
2651	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2861	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2652		2862
2653	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2863	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2654	if $x + $self->{w} > $::WIDTH;	2864	if $x + $self->{w} > $self->{root}{w};
2655		2865
2656	$self->move_abs ($x, $y);	2866	$self->move_abs ($x, $y);
2657	});	2867	});
2658	}	2868	}
2659		2869
…		…
2748	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2958	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2749		2959
2750	if ($tex) {	2960	if ($tex) {
2751	glEnable GL_TEXTURE_2D;	2961	glEnable GL_TEXTURE_2D;
2752	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2962	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2753	glColor 1, 1, 1, 1;	2963	glColor 0, 0, 0, 1;
2754	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2964	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2755	glDisable GL_TEXTURE_2D;	2965	glDisable GL_TEXTURE_2D;
2756	}	2966	}
2757	}	2967	}
2758		2968
2759	sub DESTROY {	2969	sub destroy {
2760	my ($self) = @_;	2970	my ($self) = @_;
2761		2971
2762	$self->{timer}->cancel	2972	$self->{timer}->cancel
2763	if $self->{timer};	2973	if $self->{timer};
2764		2974
2765	$self->SUPER::DESTROY;	2975	$self->SUPER::destroy;
2766	}	2976	}
2767		2977
2768	#############################################################################	2978	#############################################################################
2769		2979
2770	package CFClient::UI::Inventory;	2980	package CFClient::UI::Buttonbar;
2771		2981
2772	our @ISA = CFClient::UI::ScrolledWindow::;	2982	our @ISA = CFClient::UI::HBox::;
2773		2983
2774	sub new {	2984	# 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		2985
2810	#############################################################################	2986	#############################################################################
2811		2987
2812	package CFClient::UI::Menu;	2988	package CFClient::UI::Menu;
2813		2989
…		…
2825	);	3001	);
2826		3002
2827	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3003	$self->add ($self->{vbox} = new CFClient::UI::VBox);
2828		3004
2829	for my $item (@{ $self->{items} }) {	3005	for my $item (@{ $self->{items} }) {
2830	my ($widget, $cb) = @$item;	3006	my ($widget, $cb, $tooltip) = @$item;
2831		3007
2832	# handle various types of items, only text for now	3008	# handle various types of items, only text for now
2833	if (!ref $widget) {	3009	if (!ref $widget) {
2834	$widget = new CFClient::UI::Label	3010	$widget = new CFClient::UI::Label
2835	can_hover => 1,	3011	can_hover => 1,
2836	can_events => 1,	3012	can_events => 1,
2837	text => $widget;	3013	markup => $widget,
		3014	tooltip => $tooltip
2838	}	3015	}
2839		3016
2840	$self->{item}{$widget} = $item;	3017	$self->{item}{$widget} = $item;
2841		3018
2842	$self->{vbox}->add ($widget);	3019	$self->{vbox}->add ($widget);
…		…
2854	# maybe save $GRAB? must be careful about events...	3031	# maybe save $GRAB? must be careful about events...
2855	$GRAB = $self;	3032	$GRAB = $self;
2856	$self->{button} = $ev->{button};	3033	$self->{button} = $ev->{button};
2857		3034
2858	$self->show;	3035	$self->show;
2859	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3036	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2860	}	3037	}
2861		3038
2862	sub mouse_motion {	3039	sub mouse_motion {
2863	my ($self, $ev, $x, $y) = @_;	3040	my ($self, $ev, $x, $y) = @_;
2864		3041
2865	# TODO: should use vbox->find_widget or so	3042	# TODO: should use vbox->find_widget or so
2866	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3043	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2867	$self->{hover} = $self->{item}{$HOVER};	3044	$self->{hover} = $self->{item}{$HOVER};
		3045
		3046	0
2868	}	3047	}
2869		3048
2870	sub button_up {	3049	sub button_up {
2871	my ($self, $ev, $x, $y) = @_;	3050	my ($self, $ev, $x, $y) = @_;
2872		3051
…		…
2874	undef $GRAB;	3053	undef $GRAB;
2875	$self->hide;	3054	$self->hide;
2876		3055
2877	$self->_emit ("popdown");	3056	$self->_emit ("popdown");
2878	$self->{hover}[1]->() if $self->{hover};	3057	$self->{hover}[1]->() if $self->{hover};
		3058	} else {
		3059	return 0
		3060	}
		3061
2879	}	3062	1
2880	}	3063	}
2881		3064
2882	#############################################################################	3065	#############################################################################
2883		3066
2884	package CFClient::UI::Statusbox;	3067	package CFClient::UI::Multiplexer;
2885		3068
2886	our @ISA = CFClient::UI::VBox::;	3069	our @ISA = CFClient::UI::Container::;
2887		3070
2888	sub new {	3071	sub new {
2889	my $class = shift;	3072	my $class = shift;
2890		3073
2891	$class->SUPER::new (	3074	my $self = $class->SUPER::new (
		3075	@_,
		3076	);
		3077
		3078	$self->{current} = $self->{children}[0]
		3079	if @{ $self->{children} };
		3080
		3081	$self
		3082	}
		3083
		3084	sub add {
		3085	my ($self, @widgets) = @_;
		3086
		3087	$self->SUPER::add (@widgets);
		3088
		3089	$self->{current} = $self->{children}[0]
		3090	if @{ $self->{children} };
		3091	}
		3092
		3093	sub set_current_page {
		3094	my ($self, $page_or_widget) = @_;
		3095
		3096	my $widget = ref $page_or_widget
		3097	? $page_or_widget
		3098	: $self->{children}[$page_or_widget];
		3099
		3100	$self->{current} = $widget;
		3101	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3102
		3103	$self->_emit (page_changed => $self->{current});
		3104
		3105	$self->realloc;
		3106	}
		3107
		3108	sub visible_children {
		3109	$_[0]{current}
		3110	}
		3111
		3112	sub size_request {
		3113	my ($self) = @_;
		3114
		3115	$self->{current}->size_request
		3116	}
		3117
		3118	sub size_allocate {
		3119	my ($self, $w, $h) = @_;
		3120
		3121	$self->{current}->configure (0, 0, $w, $h);
		3122	}
		3123
		3124	sub _draw {
		3125	my ($self) = @_;
		3126
		3127	$self->{current}->draw;
		3128	}
		3129
		3130	#############################################################################
		3131
		3132	package CFClient::UI::Notebook;
		3133
		3134	our @ISA = CFClient::UI::VBox::;
		3135
		3136	sub new {
		3137	my $class = shift;
		3138
		3139	my $self = $class->SUPER::new (
		3140	buttonbar => (new CFClient::UI::Buttonbar),
		3141	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3142	# filter => # will be put between multiplexer and $self
		3143	@_,
		3144	);
		3145
		3146	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3147	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3148
		3149	$self
		3150	}
		3151
		3152	sub add {
		3153	my ($self, $title, $widget, $tooltip) = @_;
		3154
		3155	Scalar::Util::weaken $self;
		3156
		3157	$self->{buttonbar}->add (new CFClient::UI::Button
		3158	markup => $title,
		3159	tooltip => $tooltip,
		3160	on_activate => sub { $self->set_current_page ($widget) },
		3161	);
		3162
		3163	$self->{multiplexer}->add ($widget);
		3164	}
		3165
		3166	sub set_current_page {
		3167	my ($self, $page) = @_;
		3168
		3169	$self->{multiplexer}->set_current_page ($page);
		3170	$self->_emit (page_changed => $self->{multiplexer}{current});
		3171	}
		3172
		3173	#############################################################################
		3174
		3175	package CFClient::UI::Combobox;
		3176
		3177	use utf8;
		3178
		3179	our @ISA = CFClient::UI::Button::;
		3180
		3181	sub new {
		3182	my $class = shift;
		3183
		3184	my $self = $class->SUPER::new (
		3185	options => [], # [value, title, longdesc], ...
		3186	value => undef,
		3187	@_,
		3188	);
		3189
		3190	$self->_set_value ($self->{value});
		3191
		3192	$self
		3193	}
		3194
		3195	sub button_down {
		3196	my ($self, $ev) = @_;
		3197
		3198	my @menu_items;
		3199
		3200	for (@{ $self->{options} }) {
		3201	my ($value, $title, $tooltip) = @$_;
		3202
		3203	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3204	}
		3205
		3206	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3207	}
		3208
		3209	sub _set_value {
		3210	my ($self, $value) = @_;
		3211
		3212	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3213	or return;
		3214
		3215	$self->{value} = $item->[0];
		3216	$self->set_markup ("$item->[1] ⇓");
		3217	$self->set_tooltip ($item->[2]);
		3218	}
		3219
		3220	sub set_value {
		3221	my ($self, $value) = @_;
		3222
		3223	return unless $self->{value} ne $value;
		3224
		3225	$self->_set_value ($value);
		3226	$self->_emit (changed => $value);
		3227	}
		3228
		3229	#############################################################################
		3230
		3231	package CFClient::UI::Statusbox;
		3232
		3233	our @ISA = CFClient::UI::VBox::;
		3234
		3235	sub new {
		3236	my $class = shift;
		3237
		3238	my $self = $class->SUPER::new (
2892	fontsize => 0.8,	3239	fontsize => 0.8,
2893	@_,	3240	@_,
2894	)	3241	);
		3242
		3243	Scalar::Util::weaken (my $this = $self);
		3244
		3245	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3246
		3247	$self
2895	}	3248	}
2896		3249
2897	sub reorder {	3250	sub reorder {
2898	my ($self) = @_;	3251	my ($self) = @_;
2899	my $NOW = time;	3252	my $NOW = Time::HiRes::time;
		3253
		3254	# freeze display when hovering over any label
		3255	return if $CFClient::UI::TOOLTIP->{owner}
		3256	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3257	values %{ $self->{item} };
2900		3258
2901	while (my ($k, $v) = each %{ $self->{item} }) {	3259	while (my ($k, $v) = each %{ $self->{item} }) {
2902	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3260	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2903	}	3261	}
2904		3262
…		…
2907	my @items = sort {	3265	my @items = sort {
2908	$a->{pri} <=> $b->{pri}	3266	$a->{pri} <=> $b->{pri}
2909	or $b->{id} <=> $a->{id}	3267	or $b->{id} <=> $a->{id}
2910	} values %{ $self->{item} };	3268	} values %{ $self->{item} };
2911		3269
		3270	$self->{timer}->interval (1);
		3271
2912	my $count = 10 + 1;	3272	my $count = 10 + 1;
2913	for my $item (@items) {	3273	for my $item (@items) {
2914	last unless --$count;	3274	last unless --$count;
2915		3275
2916	push @widgets, $item->{label} ||= do {	3276	my $label = $item->{label} ||= do {
2917	# TODO: doesn't handle markup well (read as: at all)	3277	# TODO: doesn't handle markup well (read as: at all)
2918	my $short = $item->{count} > 1	3278	my $short = $item->{count} > 1
2919	? "<b>$item->{count} ×</b> $item->{text}"	3279	? "<b>$item->{count} ×</b> $item->{text}"
2920	: $item->{text};	3280	: $item->{text};
2921		3281
…		…
2929	tooltip => $item->{tooltip},	3289	tooltip => $item->{tooltip},
2930	tooltip_font => $::FONT_PROP,	3290	tooltip_font => $::FONT_PROP,
2931	tooltip_width => 0.67,	3291	tooltip_width => 0.67,
2932	fontsize => $item->{fontsize} || $self->{fontsize},	3292	fontsize => $item->{fontsize} || $self->{fontsize},
2933	max_w => $::WIDTH * 0.44,	3293	max_w => $::WIDTH * 0.44,
2934	fg => $item->{fg},	3294	fg => [@{ $item->{fg} }],
2935	can_events => 1,	3295	can_events => 1,
2936	can_hover => 1	3296	can_hover => 1
2937	};	3297	};
		3298
		3299	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3300	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3301	$label->update;
		3302	$label->set_max_size (undef, $label->{req_h} * $diff)
		3303	if $diff < 1;
		3304	$self->{timer}->interval (1/30);
		3305	} else {
		3306	$label->{fg}[3] = $item->{fg}[3] || 1;
		3307	}
		3308
		3309	push @widgets, $label;
2938	}	3310	}
2939		3311
2940	$self->clear;	3312	$self->clear;
2941	$self->SUPER::add (reverse @widgets);	3313	$self->SUPER::add (reverse @widgets);
2942	}	3314	}
…		…
2947	$text =~ s/^\s+//;	3319	$text =~ s/^\s+//;
2948	$text =~ s/\s+$//;	3320	$text =~ s/\s+$//;
2949		3321
2950	return unless $text;	3322	return unless $text;
2951		3323
2952	my $timeout = time + ((delete $arg{timeout}) || 60);	3324	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2953		3325
2954	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3326	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2955		3327
2956	if (my $item = $self->{item}{$group}) {	3328	if (my $item = $self->{item}{$group}) {
2957	if ($item->{text} eq $text) {	3329	if ($item->{text} eq $text) {
2958	$item->{count}++;	3330	$item->{count}++;
2959	} else {	3331	} else {
2960	$item->{count} = 1;	3332	$item->{count} = 1;
2961	$item->{text} = $item->{tooltip} = $text;	3333	$item->{text} = $item->{tooltip} = $text;
2962	}	3334	}
2963	$item->{id} = ++$self->{id};	3335	$item->{id} += 0.2;#d#
2964	$item->{timeout} = $timeout;	3336	$item->{timeout} = $timeout;
2965	delete $item->{label};	3337	delete $item->{label};
2966	} else {	3338	} else {
2967	$self->{item}{$group} = {	3339	$self->{item}{$group} = {
2968	id => ++$self->{id},	3340	id => ++$self->{id},
…		…
2987		3359
2988	$self->reorder;	3360	$self->reorder;
2989	$self->SUPER::reconfigure;	3361	$self->SUPER::reconfigure;
2990	}	3362	}
2991		3363
		3364	sub destroy {
		3365	my ($self) = @_;
		3366
		3367	$self->{timer}->cancel;
		3368
		3369	$self->SUPER::destroy;
		3370	}
		3371
2992	#############################################################################	3372	#############################################################################
2993		3373
		3374	package CFClient::UI::Inventory;
		3375
		3376	our @ISA = CFClient::UI::ScrolledWindow::;
		3377
		3378	sub new {
		3379	my $class = shift;
		3380
		3381	my $self = $class->SUPER::new (
		3382	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3383	@_,
		3384	);
		3385
		3386	$self
		3387	}
		3388
		3389	sub set_items {
		3390	my ($self, $items) = @_;
		3391
		3392	$self->{child}->clear;
		3393	return unless $items;
		3394
		3395	my @items = sort {
		3396	($a->{type} <=> $b->{type})
		3397	or ($a->{name} cmp $b->{name})
		3398	} @$items;
		3399
		3400	$self->{real_items} = \@items;
		3401
		3402	my $row = 0;
		3403	for my $item (@items) {
		3404	CFClient::Item::update_widgets $item;
		3405
		3406	$self->{child}->add (0, $row, $item->{face_widget});
		3407	$self->{child}->add (1, $row, $item->{desc_widget});
		3408	$self->{child}->add (2, $row, $item->{weight_widget});
		3409
		3410	$row++;
		3411	}
		3412	}
		3413
		3414	#############################################################################
		3415
		3416	package CFClient::UI::BindEditor;
		3417
		3418	our @ISA = CFClient::UI::FancyFrame::;
		3419
		3420	sub new {
		3421	my $class = shift;
		3422
		3423	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3424
		3425	$self->add (my $vb = new CFClient::UI::VBox);
		3426
		3427
		3428	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3429	text => "start recording",
		3430	tooltip => "Start/Stops recording of actions."
		3431	."All subsequent actions after the recording started will be captured."
		3432	."The actions are displayed after the record was stopped."
		3433	."To bind the action you have to click on the 'Bind' button",
		3434	on_activate => sub {
		3435	unless ($self->{recording}) {
		3436	$self->start;
		3437	} else {
		3438	$self->stop;
		3439	}
		3440	});
		3441
		3442	$vb->add (new CFClient::UI::Label text => "Actions:");
		3443	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3444
		3445	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3446	$vb->add (my $hb = new CFClient::UI::HBox);
		3447	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3448	$hb->add (new CFClient::UI::Button
		3449	text => "bind",
		3450	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3451	on_activate => sub {
		3452	$self->ask_for_bind;
		3453	});
		3454
		3455	$vb->add (my $hb = new CFClient::UI::HBox);
		3456	$hb->add (new CFClient::UI::Button
		3457	text => "ok",
		3458	expand => 1,
		3459	tooltip => "This closes the binding editor and saves the binding",
		3460	on_activate => sub {
		3461	$self->hide;
		3462	$self->commit;
		3463	});
		3464
		3465	$hb->add (new CFClient::UI::Button
		3466	text => "cancel",
		3467	expand => 1,
		3468	tooltip => "This closes the binding editor without saving",
		3469	on_activate => sub {
		3470	$self->hide;
		3471	$self->{binding_cancel}->()
		3472	if $self->{binding_cancel};
		3473	});
		3474
		3475	$self->update_binding_widgets;
		3476
		3477	$self
		3478	}
		3479
		3480	sub commit {
		3481	my ($self) = @_;
		3482	my ($mod, $sym, $cmds) = $self->get_binding;
		3483	if ($sym != 0 && @$cmds > 0) {
		3484	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3485	."'. Don't forget 'Save Config'!");
		3486	$self->{binding_change}->($mod, $sym, $cmds)
		3487	if $self->{binding_change};
		3488	} else {
		3489	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3490	$self->{binding_cancel}->()
		3491	if $self->{binding_cancel};
		3492	}
		3493	}
		3494
		3495	sub start {
		3496	my ($self) = @_;
		3497
		3498	$self->{rec_btn}->set_text ("stop recording");
		3499	$self->{recording} = 1;
		3500	$self->clear_command_list;
		3501	$::CONN->start_record if $::CONN;
		3502	}
		3503
		3504	sub stop {
		3505	my ($self) = @_;
		3506
		3507	$self->{rec_btn}->set_text ("start recording");
		3508	$self->{recording} = 0;
		3509
		3510	my $rec;
		3511	$rec = $::CONN->stop_record if $::CONN;
		3512	return unless ref $rec eq 'ARRAY';
		3513	$self->set_command_list ($rec);
		3514	}
		3515
		3516
		3517	sub ask_for_bind_and_commit {
		3518	my ($self) = @_;
		3519	$self->ask_for_bind (1);
		3520	}
		3521
		3522	sub ask_for_bind {
		3523	my ($self, $commit, $end_cb) = @_;
		3524
		3525	CFClient::Binder::open_binding_dialog (sub {
		3526	my ($mod, $sym) = @_;
		3527	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3528	$self->update_binding_widgets;
		3529	$self->commit if $commit;
		3530	$end_cb->() if $end_cb;
		3531	});
		3532	}
		3533
		3534	# $mod and $sym are the modifiers and key symbol
		3535	# $cmds is a array ref of strings (the commands)
		3536	# $cb is the callback that is executed on OK
		3537	# $ccb is the callback that is executed on CANCEL and
		3538	# when the binding was unsuccessful on OK
		3539	sub set_binding {
		3540	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3541
		3542	$self->clear_command_list;
		3543	$self->{recording} = 0;
		3544	$self->{rec_btn}->set_text ("start recording");
		3545
		3546	$self->{binding} = [$mod, $sym];
		3547	$self->{commands} = $cmds;
		3548
		3549	$self->{binding_change} = $cb;
		3550	$self->{binding_cancel} = $ccb;
		3551
		3552	$self->update_binding_widgets;
		3553	}
		3554
		3555	# this is a shortcut method that asks for a binding
		3556	# and then just binds it.
		3557	sub do_quick_binding {
		3558	my ($self, $cmds, $end_cb) = @_;
		3559	$self->set_binding (undef, undef, $cmds, sub {
		3560	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3561	});
		3562	$self->ask_for_bind (1, $end_cb);
		3563	}
		3564
		3565	sub update_binding_widgets {
		3566	my ($self) = @_;
		3567	my ($mod, $sym, $cmds) = $self->get_binding;
		3568	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3569	$self->set_command_list ($cmds);
		3570	}
		3571
		3572	sub get_binding {
		3573	my ($self) = @_;
		3574	return (
		3575	$self->{binding}->[0],
		3576	$self->{binding}->[1],
		3577	[ grep { defined $_ } @{$self->{commands}} ]
		3578	);
		3579	}
		3580
		3581	sub clear_command_list {
		3582	my ($self) = @_;
		3583	$self->{cmdbox}->clear ();
		3584	}
		3585
		3586	sub set_command_list {
		3587	my ($self, $cmds) = @_;
		3588
		3589	$self->{cmdbox}->clear ();
		3590	$self->{commands} = $cmds;
		3591
		3592	my $idx = 0;
		3593
		3594	for (@$cmds) {
		3595	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3596
		3597	my $i = $idx;
		3598	$hb->add (new CFClient::UI::Label text => $_);
		3599	$hb->add (new CFClient::UI::Button
		3600	text => "delete",
		3601	tooltip => "Deletes the action from the record",
		3602	on_activate => sub {
		3603	$self->{cmdbox}->remove ($hb);
		3604	$cmds->[$i] = undef;
		3605	});
		3606
		3607
		3608	$idx++
		3609	}
		3610	}
		3611
		3612	#############################################################################
		3613
		3614	package CFClient::UI::SpellList;
		3615
		3616	our @ISA = CFClient::UI::Table::;
		3617
		3618	sub new {
		3619	my $class = shift;
		3620
		3621	my $self = $class->SUPER::new (
		3622	binding => [],
		3623	commands => [],
		3624	@_,
		3625	)
		3626	}
		3627
		3628	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3629
		3630	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3631	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3632	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3633	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3634	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3635	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3636	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3637	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3638	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3639	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3640
		3641	sub rebuild_spell_list {
		3642	my ($self) = @_;
		3643
		3644	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3645	$self->clear;
		3646
		3647	return unless $::CONN;
		3648
		3649	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3650	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3651	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3652	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3653	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3654
		3655	my $row = 0;
		3656
		3657	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3658	my $spell = $self->{spell}{$_};
		3659
		3660	$row++;
		3661
		3662	my $spell_cb = sub {
		3663	my ($widget, $ev) = @_;
		3664
		3665	if ($ev->{button} == 1) {
		3666	$::CONN->user_send ("cast $spell->{name}");
		3667	} elsif ($ev->{button} == 2) {
		3668	$::CONN->user_send ("invoke $spell->{name}");
		3669	} elsif ($ev->{button} == 3) {
		3670	(new CFClient::UI::Menu
		3671	items => [
		3672	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3673	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3674	],
		3675	)->popup ($ev);
		3676	} else {
		3677	return 0;
		3678	}
		3679
		3680	1
		3681	};
		3682
		3683	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3684
		3685	#TODO: add path info to tooltip
		3686	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3687
		3688	$self->add (0, $row, new CFClient::UI::Face
		3689	face => $spell->{face},
		3690	can_hover => 1,
		3691	can_events => 1,
		3692	tooltip => $tooltip,
		3693	on_button_down => $spell_cb,
		3694	);
		3695
		3696	$self->add (1, $row, new CFClient::UI::Label
		3697	expand => 1,
		3698	text => $spell->{name},
		3699	can_hover => 1,
		3700	can_events => 1,
		3701	tooltip => $tooltip,
		3702	on_button_down => $spell_cb,
		3703	);
		3704
		3705	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3706	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3707	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3708	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3709	}
		3710	});
		3711	}
		3712
		3713	sub add_spell {
		3714	my ($self, $spell) = @_;
		3715
		3716	$self->{spell}->{$spell->{name}} = $spell;
		3717	$self->rebuild_spell_list;
		3718	}
		3719
		3720	sub remove_spell {
		3721	my ($self, $spell) = @_;
		3722
		3723	delete $self->{spell}->{$spell->{name}};
		3724	$self->rebuild_spell_list;
		3725	}
		3726
		3727	sub clear_spells {
		3728	my ($self) = @_;
		3729
		3730	$self->{spell} = {};
		3731	$self->rebuild_spell_list;
		3732	}
		3733
		3734	#############################################################################
		3735
2994	package CFClient::UI::Root;	3736	package CFClient::UI::Root;
2995		3737
2996	our @ISA = CFClient::UI::Container::;	3738	our @ISA = CFClient::UI::Container::;
		3739
		3740	use List::Util qw(min max);
2997		3741
2998	use CFClient::OpenGL;	3742	use CFClient::OpenGL;
2999		3743
3000	sub new {	3744	sub new {
3001	my $class = shift;	3745	my $class = shift;
…		…
3008	Scalar::Util::weaken ($self->{root} = $self);	3752	Scalar::Util::weaken ($self->{root} = $self);
3009		3753
3010	$self	3754	$self
3011	}	3755	}
3012		3756
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 {	3757	sub size_request {
3030	my ($self) = @_;	3758	my ($self) = @_;
3031		3759
3032	($self->{w}, $self->{h})	3760	($self->{w}, $self->{h})
3033	}	3761	}
…		…
3045		3773
3046	int $coord + 0.5	3774	int $coord + 0.5
3047	}	3775	}
3048		3776
3049	sub size_allocate {	3777	sub size_allocate {
3050	my ($self, $w, $h, $changed) = @_;	3778	my ($self, $w, $h) = @_;
3051		3779
3052	for my $child ($self->children) {	3780	for my $child ($self->children) {
3053	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3781	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3054		3782
3055	$X = $child->{force_x} if exists $child->{force_x};	3783	$X = $child->{force_x} if exists $child->{force_x};
…		…
3123	$_->()	3851	$_->()
3124	for values %{delete $self->{refresh_hook}};	3852	for values %{delete $self->{refresh_hook}};
3125	}	3853	}
3126		3854
3127	if ($self->{realloc}) {	3855	if ($self->{realloc}) {
		3856	my %queue;
3128	my @queue;	3857	my @queue;
		3858	my $widget;
3129		3859
		3860	outer:
3130	while () {	3861	while () {
3131	if ($self->{realloc}) {	3862	if (my $realloc = delete $self->{realloc}) {
3132	#TODO use array-of-depth approach	3863	for $widget (values %$realloc) {
		3864	$widget->{visible} or next; # do not resize invisible widgets
3133		3865
3134	@queue = sort { $a->{visible} <=> $b->{visible} }	3866	$queue{$widget+0}++ and next; # duplicates are common
3135	@queue, values %{delete $self->{realloc}};	3867
		3868	push @{ $queue[$widget->{visible}] }, $widget;
		3869	}
3136	}	3870	}
3137		3871
		3872	while () {
		3873	@queue or last outer;
		3874
3138	my $widget = pop @queue || last;	3875	$widget = pop @{ $queue[-1] || [] }
		3876	and last;
		3877
		3878	pop @queue;
		3879	}
3139		3880
3140	$widget->{visible} or last; # do not resize invisible widgets	3881	delete $queue{$widget+0};
3141		3882
3142	my ($w, $h) = $widget->size_request;	3883	my ($w, $h) = $widget->size_request;
3143		3884
3144	my $min_size = $widget->{is_toplevel} ? 16 : 0;	3885	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3886	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3145		3887
3146	$w = List::Util::max $widget->{min_w} || $widget->{is_toplevel} * 16, $w;	3888	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
3147	$h = List::Util::max $widget->{min_h} || $widget->{is_toplevel} * 16, $h;	3889	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3148		3890
3149	$w = $widget->{force_w} if exists $widget->{force_w};	3891	$w = $widget->{force_w} if exists $widget->{force_w};
3150	$h = $widget->{force_h} if exists $widget->{force_h};	3892	$h = $widget->{force_h} if exists $widget->{force_h};
3151		3893
		3894	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3895	|| delete $widget->{force_realloc}) {
3152	$widget->{req_w} = $w;	3896	$widget->{req_w} = $w;
3153	$widget->{req_h} = $h;	3897	$widget->{req_h} = $h;
3154		3898
3155	$self->{size_alloc}{$widget} = [$widget, undef, undef];	3899	$self->{size_alloc}{$widget+0} = $widget;
3156		3900
3157	push @queue, $widget->{parent}	3901	if (my $parent = $widget->{parent}) {
3158	if ($self->{w} != $w || $self->{h} != $h) && $widget->{parent};	3902	$self->{realloc}{$parent+0} = $parent
		3903	unless $queue{$parent+0};
		3904
		3905	$parent->{force_size_alloc} = 1;
		3906	$self->{size_alloc}{$parent+0} = $parent;
		3907	}
		3908	}
		3909
		3910	delete $self->{realloc}{$widget+0};
3159	}	3911	}
3160	}	3912	}
3161		3913
3162	while (my $size_alloc = delete $self->{size_alloc}) {	3914	while (my $size_alloc = delete $self->{size_alloc}) {
3163	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3915	my @queue = sort { $b->{visible} <=> $a->{visible} }
3164	values %$size_alloc;	3916	values %$size_alloc;
3165		3917
3166	while () {	3918	while () {
3167	my ($widget, $w, $h) = @{ pop @queue or last };	3919	my $widget = pop @queue || last;
3168		3920
3169	$w = $widget->{w} || $widget->{req_w} unless defined $w;	3921	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3170	$h = $widget->{h} || $widget->{req_h} unless defined $h;
3171		3922
3172	$w = 0 if $w < 0;	3923	$w = 0 if $w < 0;
3173	$h = 0 if $h < 0;	3924	$h = 0 if $h < 0;
3174		3925
3175	$w = int $w + 0.5;	3926	$w = int $w + 0.5;
3176	$h = int $h + 0.5;	3927	$h = int $h + 0.5;
3177		3928
3178	my $changed = $widget->{w} != $w || $widget->{h} != $h;	3929	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3930	$widget->{old_w} = $widget->{w};
		3931	$widget->{old_h} = $widget->{h};
3179		3932
3180	$widget->{w} = $w;	3933	$widget->{w} = $w;
3181	$widget->{h} = $h;	3934	$widget->{h} = $h;
3182		3935
3183	$widget->emit (size_allocate => $w, $h, $changed);	3936	$widget->emit (size_allocate => $w, $h);
		3937	}
3184	}	3938	}
3185	}	3939	}
3186		3940
3187	while ($self->{post_alloc_hook}) {	3941	while ($self->{post_alloc_hook}) {
3188	$_->()	3942	$_->()
3189	for values %{delete $self->{post_alloc_hook}};	3943	for values %{delete $self->{post_alloc_hook}};
3190	}	3944	}
		3945
3191		3946
3192	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3947	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3193	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3948	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3194	glClear GL_COLOR_BUFFER_BIT;	3949	glClear GL_COLOR_BUFFER_BIT;
3195		3950
…		…
3197	glLoadIdentity;	3952	glLoadIdentity;
3198	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3953	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3199	glMatrixMode GL_MODELVIEW;	3954	glMatrixMode GL_MODELVIEW;
3200	glLoadIdentity;	3955	glLoadIdentity;
3201		3956
		3957	{
		3958	package CFClient::UI::Base;
		3959
		3960	($draw_x, $draw_y, $draw_w, $draw_h) =
		3961	(0, 0, $self->{w}, $self->{h});
		3962	}
		3963
3202	$self->_draw;	3964	$self->_draw;
3203	}	3965	}
3204		3966
3205	#############################################################################	3967	#############################################################################
3206		3968

Diff Legend

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