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.256 by root, Tue May 30 01:42:16 2006 UTC vs.
Revision 1.303 by elmex, Tue Jun 13 10:28:38 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	is_toplevel => 1,
1032	can_events => 1,	1082	can_events => 1,
1033	@_	1083	min_w => 16,
		1084	min_h => 16,
		1085	%arg,
1034	);	1086	);
1035		1087
1036	$self->{title} &&= new CFClient::UI::Label	1088	$self->{title_widget} = new CFClient::UI::Label
1037	align => 0,	1089	align => 0,
1038	valign => 1,	1090	valign => 1,
1039	text => $self->{title},	1091	text => $self->{title},
1040	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	}
1041		1103
1042	$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};
1043	}	1113	}
1044		1114
1045	sub border {	1115	sub border {
1046	int $_[0]{border} * $::FONTSIZE	1116	int $_[0]{border} * $::FONTSIZE
1047	}	1117	}
1048		1118
1049	sub size_request {	1119	sub size_request {
1050	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};
1051		1127
1052	my ($w, $h) = $self->SUPER::size_request;	1128	my ($w, $h) = $self->SUPER::size_request;
1053		1129
1054	(	1130	(
1055	$w + $self->border * 2,	1131	$w + $self->border * 2,
1056	$h + $self->border * 2,	1132	$h + $self->border * 2,
1057	)	1133	)
1058	}	1134	}
1059		1135
1060	sub size_allocate {	1136	sub size_allocate {
1061	my ($self, $w, $h, $changed) = @_;	1137	my ($self, $w, $h) = @_;
1062		1138
1063	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	}
1064		1144
		1145	my $border = $self->border;
		1146
1065	$h -= List::Util::max 0, $self->border * 2;	1147	$h -= List::Util::max 0, $border * 2;
1066	$w -= List::Util::max 0, $self->border * 2;	1148	$w -= List::Util::max 0, $border * 2;
1067		1149
1068	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1069	if $self->{title};
1070
1071	$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};
1072	}	1154	}
1073		1155
1074	sub button_down {	1156	sub button_down {
1075	my ($self, $ev, $x, $y) = @_;	1157	my ($self, $ev, $x, $y) = @_;
1076		1158
…		…
1095	my $dy = $ev->{y} - $oy;	1177	my $dy = $ev->{y} - $oy;
1096		1178
1097	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1179	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1098	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1180	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1099		1181
		1182	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1100	$self->realloc;	1183	$self->realloc;
1101	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1102	};	1184	};
1103		1185
1104	} elsif ($lr ^ $td) {	1186	} elsif ($lr ^ $td) {
1105	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1187	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1106	my ($bx, $by) = ($self->{x}, $self->{y});	1188	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1109	my ($ev, $x, $y) = @_;	1191	my ($ev, $x, $y) = @_;
1110		1192
1111	($x, $y) = ($ev->{x}, $ev->{y});	1193	($x, $y) = ($ev->{x}, $ev->{y});
1112		1194
1113	$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});
1114	};	1198	};
		1199	} else {
		1200	return 0;
		1201	}
		1202
1115	}	1203	1
1116	}	1204	}
1117		1205
1118	sub button_up {	1206	sub button_up {
1119	my ($self, $ev, $x, $y) = @_;	1207	my ($self, $ev, $x, $y) = @_;
1120		1208
		1209	$self->{close_btn}->button_up ($ev, $x, $y)
		1210	if $self->{close_btn};
		1211
1121	delete $self->{motion};	1212	!!delete $self->{motion}
1122	}	1213	}
1123		1214
1124	sub mouse_motion {	1215	sub mouse_motion {
1125	my ($self, $ev, $x, $y) = @_;	1216	my ($self, $ev, $x, $y) = @_;
1126		1217
1127	$self->{motion}->($ev, $x, $y) if $self->{motion};	1218	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1219
		1220	!!$self->{motion}
1128	}	1221	}
1129		1222
1130	sub _draw {	1223	sub _draw {
1131	my ($self) = @_;	1224	my ($self) = @_;
1132		1225
		1226	my $child = $self->{children}[0];
		1227
1133	my ($w, $h ) = ($self->{w}, $self->{h});	1228	my ($w, $h ) = ($self->{w}, $self->{h});
1134	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1229	my ($cw, $ch) = ($child->{w}, $child->{h});
1135		1230
1136	glEnable GL_TEXTURE_2D;	1231	glEnable GL_TEXTURE_2D;
1137	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1232	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1138		1233
1139	my $border = $self->border;	1234	my $border = $self->border;
…		…
1154	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1249	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1155	}	1250	}
1156		1251
1157	glDisable GL_TEXTURE_2D;	1252	glDisable GL_TEXTURE_2D;
1158		1253
1159	$self->{title}->draw if $self->{title};
1160
1161	$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};
1162	}	1265	}
1163		1266
1164	#############################################################################	1267	#############################################################################
1165		1268
1166	package CFClient::UI::Table;	1269	package CFClient::UI::Table;
…		…
1189		1292
1190	$child->set_parent ($self);	1293	$child->set_parent ($self);
1191	$self->{children}[$y][$x] = $child;	1294	$self->{children}[$y][$x] = $child;
1192		1295
1193	$self->realloc;	1296	$self->realloc;
		1297	}
		1298
		1299	sub remove {
		1300	my ($self, $child) = @_;
		1301
		1302	# TODO: not yet implemented
1194	}	1303	}
1195		1304
1196	# 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?
1197	sub clear {	1306	sub clear {
1198	my ($self) = @_;	1307	my ($self) = @_;
…		…
1240	(sum @$hs),	1349	(sum @$hs),
1241	)	1350	)
1242	}	1351	}
1243		1352
1244	sub size_allocate {	1353	sub size_allocate {
1245	my ($self, $w, $h, $changed) = @_;	1354	my ($self, $w, $h) = @_;
1246		1355
1247	my ($ws, $hs) = $self->get_wh;	1356	my ($ws, $hs) = $self->get_wh;
1248		1357
1249	my $req_w = (sum @$ws) || 1;	1358	my $req_w = (sum @$ws) || 1;
1250	my $req_h = (sum @$hs) || 1;	1359	my $req_h = (sum @$hs) || 1;
…		…
1328	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1437	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1329	)	1438	)
1330	}	1439	}
1331		1440
1332	sub size_allocate {	1441	sub size_allocate {
1333	my ($self, $w, $h, $changed) = @_;	1442	my ($self, $w, $h) = @_;
1334		1443
1335	my $space = $self->{vertical} ? $h : $w;	1444	my $space = $self->{vertical} ? $h : $w;
1336	my $children = $self->{children};	1445	my $children = $self->{children};
1337		1446
1338	my @req;	1447	my @req;
…		…
1421	ellipsise => 3, # end	1530	ellipsise => 3, # end
1422	layout => (new CFClient::Layout),	1531	layout => (new CFClient::Layout),
1423	fontsize => 1,	1532	fontsize => 1,
1424	align => -1,	1533	align => -1,
1425	valign => -1,	1534	valign => -1,
1426	padding => 2,	1535	padding_x => 2,
		1536	padding_y => 2,
1427	can_events => 0,	1537	can_events => 0,
1428	%arg	1538	%arg
1429	);	1539	);
1430		1540
1431	if (exists $self->{template}) {	1541	if (exists $self->{template}) {
…		…
1458		1568
1459	delete $self->{texture};	1569	delete $self->{texture};
1460	$self->SUPER::update;	1570	$self->SUPER::update;
1461	}	1571	}
1462		1572
		1573	sub realloc {
		1574	my ($self) = @_;
		1575
		1576	delete $self->{ox};
		1577	$self->SUPER::realloc;
		1578	}
		1579
1463	sub set_text {	1580	sub set_text {
1464	my ($self, $text) = @_;	1581	my ($self, $text) = @_;
1465		1582
1466	return if $self->{text} eq "T$text";	1583	return if $self->{text} eq "T$text";
1467	$self->{text} = "T$text";	1584	$self->{text} = "T$text";
1468		1585
1469	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1586	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1470	$self->{layout}->set_text ($text);	1587	$self->{layout}->set_text ($text);
1471		1588
		1589	delete $self->{size_req};
1472	$self->realloc;	1590	$self->realloc;
1473	$self->update;	1591	$self->update;
1474	}	1592	}
1475		1593
1476	sub set_markup {	1594	sub set_markup {
…		…
1482	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1600	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1483		1601
1484	$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;
1485	$self->{layout}->set_markup ($markup);	1603	$self->{layout}->set_markup ($markup);
1486		1604
		1605	delete $self->{size_req};
1487	$self->realloc;	1606	$self->realloc;
1488	$self->update;	1607	$self->update;
1489	}	1608	}
1490		1609
1491	sub size_request {	1610	sub size_request {
1492	my ($self) = @_;	1611	my ($self) = @_;
1493		1612
		1613	$self->{size_req} ||= do {
1494	$self->{layout}->set_font ($self->{font}) if $self->{font};	1614	$self->{layout}->set_font ($self->{font}) if $self->{font};
1495	$self->{layout}->set_width ($self->{max_w} || -1);	1615	$self->{layout}->set_width ($self->{max_w} || -1);
1496	$self->{layout}->set_ellipsise ($self->{ellipsise});	1616	$self->{layout}->set_ellipsise ($self->{ellipsise});
1497	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1617	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1498	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1618	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1499		1619
1500	my ($w, $h) = $self->{layout}->size;	1620	my ($w, $h) = $self->{layout}->size;
1501		1621
1502	if (exists $self->{template}) {	1622	if (exists $self->{template}) {
1503	$self->{template}->set_font ($self->{font}) if $self->{font};	1623	$self->{template}->set_font ($self->{font}) if $self->{font};
1504	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1624	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1505		1625
1506	my ($w2, $h2) = $self->{template}->size;	1626	my ($w2, $h2) = $self->{template}->size;
1507		1627
1508	$w = List::Util::max $w, $w2;	1628	$w = List::Util::max $w, $w2;
1509	$h = List::Util::max $h, $h2;	1629	$h = List::Util::max $h, $h2;
		1630	}
		1631
		1632	[$w, $h]
1510	}	1633	};
1511		1634
1512	(	1635	@{ $self->{size_req} }
1513	$w + $self->{padding} * 2,
1514	$h + $self->{padding} * 2,
1515	)
1516	}	1636	}
1517		1637
1518	sub size_allocate {	1638	sub size_allocate {
1519	my ($self, $w, $h, $changed) = @_;	1639	my ($self, $w, $h) = @_;
		1640
		1641	delete $self->{ox};
1520		1642
1521	delete $self->{texture}	1643	delete $self->{texture}
1522	if $changed;	1644	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1523	}	1645	}
1524		1646
1525	sub set_fontsize {	1647	sub set_fontsize {
1526	my ($self, $fontsize) = @_;	1648	my ($self, $fontsize) = @_;
1527		1649
1528	$self->{fontsize} = $fontsize;	1650	$self->{fontsize} = $fontsize;
1529	delete $self->{texture};	1651	delete $self->{texture};
1530		1652
1531	$self->realloc;	1653	$self->realloc;
		1654	}
		1655
		1656	sub reconfigure {
		1657	my ($self) = @_;
		1658
		1659	delete $self->{size_req};
		1660
		1661	$self->SUPER::reconfigure;
1532	}	1662	}
1533		1663
1534	sub _draw {	1664	sub _draw {
1535	my ($self) = @_;	1665	my ($self) = @_;
1536		1666
…		…
1542	$self->{layout}->set_width ($self->{w});	1672	$self->{layout}->set_width ($self->{w});
1543	$self->{layout}->set_ellipsise ($self->{ellipsise});	1673	$self->{layout}->set_ellipsise ($self->{ellipsise});
1544	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1674	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1545	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1675	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1546		1676
1547	my $tex = new_from_layout CFClient::Texture $self->{layout};	1677	new_from_layout CFClient::Texture $self->{layout}
		1678	};
1548		1679
		1680	unless (exists $self->{ox}) {
1549	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1681	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1550	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1682	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1551	: ($self->{w} - $tex->{w}) * 0.5);	1683	: ($self->{w} - $tex->{w}) * 0.5);
1552		1684
1553	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1685	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1554	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1686	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1555	: ($self->{h} - $tex->{h}) * 0.5);	1687	: ($self->{h} - $tex->{h}) * 0.5);
1556
1557	$tex
1558	};	1688	};
1559		1689
1560	glEnable GL_TEXTURE_2D;	1690	glEnable GL_TEXTURE_2D;
1561	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};
1562		1694
1563	if ($tex->{format} == GL_ALPHA) {	1695	if ($tex->{format} == GL_ALPHA) {
		1696	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1564	glColor @{$self->{fg}};	1697	glColor @{$self->{fg}};
1565	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1698	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1566	} else {	1699	} else {
		1700	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1567	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1701	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1568	}	1702	}
1569		1703
1570	glDisable GL_TEXTURE_2D;	1704	glDisable GL_TEXTURE_2D;
1571	}	1705	}
1572		1706
…		…
1589	can_hover => 1,	1723	can_hover => 1,
1590	can_focus => 1,	1724	can_focus => 1,
1591	valign => 0,	1725	valign => 0,
1592	can_events => 1,	1726	can_events => 1,
1593	#text => ...	1727	#text => ...
		1728	#hidden => "*",
1594	@_	1729	@_
1595	)	1730	)
1596	}	1731	}
1597		1732
1598	sub _set_text {	1733	sub _set_text {
…		…
1600		1735
1601	delete $self->{cur_h};	1736	delete $self->{cur_h};
1602		1737
1603	return if $self->{text} eq $text;	1738	return if $self->{text} eq $text;
1604		1739
1605	delete $self->{texture};
1606
1607	$self->{last_activity} = $::NOW;	1740	$self->{last_activity} = $::NOW;
1608	$self->{text} = $text;	1741	$self->{text} = $text;
1609		1742
1610	$text =~ s/./*/g if $self->{hidden};	1743	$text =~ s/./*/g if $self->{hidden};
1611	$self->{layout}->set_text ("$text ");	1744	$self->{layout}->set_text ("$text ");
		1745	delete $self->{size_req};
1612		1746
1613	$self->_emit (changed => $self->{text});	1747	$self->_emit (changed => $self->{text});
		1748
		1749	$self->realloc;
		1750	$self->update;
1614	}	1751	}
1615		1752
1616	sub set_text {	1753	sub set_text {
1617	my ($self, $text) = @_;	1754	my ($self, $text) = @_;
1618		1755
1619	$self->{cursor} = length $text;	1756	$self->{cursor} = length $text;
1620	$self->_set_text ($text);	1757	$self->_set_text ($text);
1621
1622	$self->realloc;
1623	}	1758	}
1624		1759
1625	sub get_text {	1760	sub get_text {
1626	$_[0]{text}	1761	$_[0]{text}
1627	}	1762	}
…		…
1657	$self->{cursor} = length $text;	1792	$self->{cursor} = length $text;
1658	} elsif ($uni == 27) {	1793	} elsif ($uni == 27) {
1659	$self->_emit ('escape');	1794	$self->_emit ('escape');
1660	} elsif ($uni) {	1795	} elsif ($uni) {
1661	substr $text, $self->{cursor}++, 0, chr $uni;	1796	substr $text, $self->{cursor}++, 0, chr $uni;
		1797	} else {
		1798	return 0;
1662	}	1799	}
1663		1800
1664	$self->_set_text ($text);	1801	$self->_set_text ($text);
1665		1802
1666	$self->realloc;	1803	$self->realloc;
		1804
		1805	1
1667	}	1806	}
1668		1807
1669	sub focus_in {	1808	sub focus_in {
1670	my ($self) = @_;	1809	my ($self) = @_;
1671		1810
…		…
1686	utf8::encode $text;	1825	utf8::encode $text;
1687	$self->{cursor} = length substr $text, 0, $idx;	1826	$self->{cursor} = length substr $text, 0, $idx;
1688		1827
1689	$self->_set_text ($self->{text});	1828	$self->_set_text ($self->{text});
1690	$self->update;	1829	$self->update;
		1830
		1831	1
1691	}	1832	}
1692		1833
1693	sub mouse_motion {	1834	sub mouse_motion {
1694	my ($self, $ev, $x, $y) = @_;	1835	my ($self, $ev, $x, $y) = @_;
1695	# 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
1696	}	1839	}
1697		1840
1698	sub _draw {	1841	sub _draw {
1699	my ($self) = @_;	1842	my ($self) = @_;
1700		1843
1701	local $self->{fg} = $self->{fg};	1844	local $self->{fg} = $self->{fg};
1702		1845
1703	if ($FOCUS == $self) {	1846	if ($FOCUS == $self) {
1704	glColor @{$self->{active_bg}};	1847	glColor_premultiply @{$self->{active_bg}};
1705	$self->{fg} = $self->{active_fg};	1848	$self->{fg} = $self->{active_fg};
1706	} else {	1849	} else {
1707	glColor @{$self->{bg}};	1850	glColor_premultiply @{$self->{bg}};
1708	}	1851	}
1709		1852
1710	glEnable GL_BLEND;	1853	glEnable GL_BLEND;
1711	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1854	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1712	glBegin GL_QUADS;	1855	glBegin GL_QUADS;
1713	glVertex 0 , 0;	1856	glVertex 0 , 0;
1714	glVertex 0 , $self->{h};	1857	glVertex 0 , $self->{h};
1715	glVertex $self->{w}, $self->{h};	1858	glVertex $self->{w}, $self->{h};
1716	glVertex $self->{w}, 0;	1859	glVertex $self->{w}, 0;
…		…
1777	} else {	1920	} else {
1778	$self->set_text ($self->{history_saveback});	1921	$self->set_text ($self->{history_saveback});
1779	}	1922	}
1780		1923
1781	} else {	1924	} else {
1782	$self->SUPER::key_down ($ev);	1925	return $self->SUPER::key_down ($ev)
		1926	}
		1927
1783	}	1928	1
1784
1785	}	1929	}
1786		1930
1787	#############################################################################	1931	#############################################################################
1788		1932
1789	package CFClient::UI::Button;	1933	package CFClient::UI::Button;
…		…
1798		1942
1799	sub new {	1943	sub new {
1800	my $class = shift;	1944	my $class = shift;
1801		1945
1802	$class->SUPER::new (	1946	$class->SUPER::new (
1803	padding => 4,	1947	padding_x => 4,
		1948	padding_y => 4,
1804	fg => [1, 1, 1],	1949	fg => [1, 1, 1],
1805	active_fg => [0, 0, 1],	1950	active_fg => [0, 0, 1],
1806	can_hover => 1,	1951	can_hover => 1,
1807	align => 0,	1952	align => 0,
1808	valign => 0,	1953	valign => 0,
…		…
1817	my ($self, $ev, $x, $y) = @_;	1962	my ($self, $ev, $x, $y) = @_;
1818		1963
1819	$self->emit ("activate")	1964	$self->emit ("activate")
1820	if $x >= 0 && $x < $self->{w}	1965	if $x >= 0 && $x < $self->{w}
1821	&& $y >= 0 && $y < $self->{h};	1966	&& $y >= 0 && $y < $self->{h};
		1967
		1968	1
1822	}	1969	}
1823		1970
1824	sub _draw {	1971	sub _draw {
1825	my ($self) = @_;	1972	my ($self) = @_;
1826		1973
1827	local $self->{fg} = $self->{fg};	1974	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1828
1829	if ($GRAB == $self) {
1830	$self->{fg} = $self->{active_fg};
1831	}
1832		1975
1833	glEnable GL_TEXTURE_2D;	1976	glEnable GL_TEXTURE_2D;
1834	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1977	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1835	glColor 0, 0, 0, 1;	1978	glColor 0, 0, 0, 1;
1836		1979
…		…
1841	$self->SUPER::_draw;	1984	$self->SUPER::_draw;
1842	}	1985	}
1843		1986
1844	#############################################################################	1987	#############################################################################
1845		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
1846	package CFClient::UI::CheckBox;	2027	package CFClient::UI::CheckBox;
1847		2028
1848	our @ISA = CFClient::UI::DrawBG::;	2029	our @ISA = CFClient::UI::DrawBG::;
1849		2030
1850	my @tex =	2031	my @tex =
…		…
1855		2036
1856	sub new {	2037	sub new {
1857	my $class = shift;	2038	my $class = shift;
1858		2039
1859	$class->SUPER::new (	2040	$class->SUPER::new (
1860	padding => 2,	2041	padding_x => 2,
		2042	padding_y => 2,
1861	fg => [1, 1, 1],	2043	fg => [1, 1, 1],
1862	active_fg => [1, 1, 0],	2044	active_fg => [1, 1, 0],
1863	bg => [0, 0, 0, 0.2],	2045	bg => [0, 0, 0, 0.2],
1864	active_bg => [1, 1, 1, 0.5],	2046	active_bg => [1, 1, 1, 0.5],
1865	state => 0,	2047	state => 0,
…		…
1869	}	2051	}
1870		2052
1871	sub size_request {	2053	sub size_request {
1872	my ($self) = @_;	2054	my ($self) = @_;
1873		2055
1874	($self->{padding} * 2 + 6) x 2	2056	(6) x 2
1875	}	2057	}
1876		2058
1877	sub button_down {	2059	sub button_down {
1878	my ($self, $ev, $x, $y) = @_;	2060	my ($self, $ev, $x, $y) = @_;
1879		2061
1880	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	2062	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1881	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	2063	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1882	$self->{state} = !$self->{state};	2064	$self->{state} = !$self->{state};
1883	$self->_emit (changed => $self->{state});	2065	$self->_emit (changed => $self->{state});
		2066	} else {
		2067	return 0
		2068	}
		2069
1884	}	2070	1
1885	}	2071	}
1886		2072
1887	sub _draw {	2073	sub _draw {
1888	my ($self) = @_;	2074	my ($self) = @_;
1889		2075
1890	$self->SUPER::_draw;	2076	$self->SUPER::_draw;
1891		2077
1892	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	2078	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1893		2079
1894	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;
1895		2083
1896	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2084	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1897		2085
1898	my $tex = $self->{state} ? $tex[1] : $tex[0];	2086	my $tex = $self->{state} ? $tex[1] : $tex[0];
1899		2087
…		…
2054		2242
2055	my $h1 = $self->{h} * (1 - $ycut1);	2243	my $h1 = $self->{h} * (1 - $ycut1);
2056	my $h2 = $self->{h} * (1 - $ycut2);	2244	my $h2 = $self->{h} * (1 - $ycut2);
2057		2245
2058	glEnable GL_BLEND;	2246	glEnable GL_BLEND;
2059	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;
2060	glEnable GL_TEXTURE_2D;	2249	glEnable GL_TEXTURE_2D;
2061	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2250	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2062		2251
2063	glBindTexture GL_TEXTURE_2D, $t1->{name};	2252	glBindTexture GL_TEXTURE_2D, $t1->{name};
2064	glBegin GL_QUADS;	2253	glBegin GL_QUADS;
…		…
2164	fg => [1, 1, 1],	2353	fg => [1, 1, 1],
2165	active_fg => [0, 0, 0],	2354	active_fg => [0, 0, 0],
2166	bg => [0, 0, 0, 0.2],	2355	bg => [0, 0, 0, 0.2],
2167	active_bg => [1, 1, 1, 0.5],	2356	active_bg => [1, 1, 1, 0.5],
2168	range => [0, 0, 100, 10, 0],	2357	range => [0, 0, 100, 10, 0],
2169	req_w => $::WIDTH / 80,	2358	min_w => $::WIDTH / 80,
2170	req_h => $::WIDTH / 80,	2359	min_h => $::WIDTH / 80,
2171	vertical => 0,	2360	vertical => 0,
2172	can_hover => 1,	2361	can_hover => 1,
2173	inner_pad => 0.02,	2362	inner_pad => 0.02,
2174	@_	2363	@_
2175	);	2364	);
…		…
2185	sub set_range {	2374	sub set_range {
2186	my ($self, $range) = @_;	2375	my ($self, $range) = @_;
2187		2376
2188	($range, $self->{range}) = ($self->{range}, $range);	2377	($range, $self->{range}) = ($self->{range}, $range);
2189		2378
2190	$self->update
2191	if "@$range" ne "@{$self->{range}}";	2379	if ("@$range" ne "@{$self->{range}}") {
		2380	$self->update;
		2381	$self->set_value ($self->{range}[0]);
		2382	}
2192	}	2383	}
2193		2384
2194	sub set_value {	2385	sub set_value {
2195	my ($self, $value) = @_;	2386	my ($self, $value) = @_;
2196		2387
…		…
2215	}	2406	}
2216		2407
2217	sub size_request {	2408	sub size_request {
2218	my ($self) = @_;	2409	my ($self) = @_;
2219		2410
2220	my $w = $self->{req_w};	2411	($self->{req_w}, $self->{req_h})
2221	my $h = $self->{req_h};
2222
2223	$self->{vertical} ? ($h, $w) : ($w, $h)
2224	}	2412	}
2225		2413
2226	sub button_down {	2414	sub button_down {
2227	my ($self, $ev, $x, $y) = @_;	2415	my ($self, $ev, $x, $y) = @_;
2228		2416
2229	$self->SUPER::button_down ($ev, $x, $y);	2417	$self->SUPER::button_down ($ev, $x, $y);
2230		2418
2231	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2419	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2232		2420
2233	$self->mouse_motion ($ev, $x, $y);	2421	$self->mouse_motion ($ev, $x, $y)
2234	}	2422	}
2235		2423
2236	sub mouse_motion {	2424	sub mouse_motion {
2237	my ($self, $ev, $x, $y) = @_;	2425	my ($self, $ev, $x, $y) = @_;
2238		2426
…		…
2242	my (undef, $lo, $hi, $page) = @{$self->{range}};	2430	my (undef, $lo, $hi, $page) = @{$self->{range}};
2243		2431
2244	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2432	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2245		2433
2246	$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
2247	}	2439	1
2248	}	2440	}
2249		2441
2250	sub update {	2442	sub update {
2251	my ($self) = @_;	2443	my ($self) = @_;
2252		2444
2253	$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}) {
2254	$self->set_value ($self->{range}[0]);	2453	$self->set_value ($self->{range}[0]);
2255		2454
2256	my ($value, $lo, $hi, $page) = @{$self->{range}};	2455	my ($value, $lo, $hi, $page) = @{$self->{range}};
2257	my $range = ($hi - $page - $lo) || 1e-100;	2456	my $range = ($hi - $page - $lo) || 1e-100;
2258		2457
…		…
2264	$value = ($value - $lo) / $range;	2463	$value = ($value - $lo) / $range;
2265	$value = $value * $self->{scale} + $self->{offset};	2464	$value = $value * $self->{scale} + $self->{offset};
2266		2465
2267	$self->{knob_x} = $value - $knob_w * 0.5;	2466	$self->{knob_x} = $value - $knob_w * 0.5;
2268	$self->{knob_w} = $knob_w;	2467	$self->{knob_w} = $knob_w;
2269	});	2468	}
2270
2271	$self->SUPER::update;
2272	}
2273
2274	sub _draw {
2275	my ($self) = @_;
2276		2469
2277	$self->SUPER::_draw ();	2470	$self->SUPER::_draw ();
2278		2471
2279	glScale $self->{w}, $self->{h};	2472	glScale $self->{w}, $self->{h};
2280		2473
…		…
2341	sub set_range { shift->{slider}->set_range (@_) }	2534	sub set_range { shift->{slider}->set_range (@_) }
2342	sub set_value { shift->{slider}->set_value (@_) }	2535	sub set_value { shift->{slider}->set_value (@_) }
2343		2536
2344	#############################################################################	2537	#############################################################################
2345		2538
2346	package CFClient::UI::TextView;	2539	package CFClient::UI::TextScroller;
2347		2540
2348	our @ISA = CFClient::UI::HBox::;	2541	our @ISA = CFClient::UI::HBox::;
2349		2542
2350	use CFClient::OpenGL;	2543	use CFClient::OpenGL;
2351		2544
…		…
2353	my $class = shift;	2546	my $class = shift;
2354		2547
2355	my $self = $class->SUPER::new (	2548	my $self = $class->SUPER::new (
2356	fontsize => 1,	2549	fontsize => 1,
2357	can_events => 0,	2550	can_events => 0,
		2551	indent => 0,
2358	#font => default_font	2552	#font => default_font
2359	@_,	2553	@_,
2360		2554
2361	layout => (new CFClient::Layout 1),	2555	layout => (new CFClient::Layout 1),
2362	par => [],	2556	par => [],
…		…
2378	$self->{fontsize} = $fontsize;	2572	$self->{fontsize} = $fontsize;
2379	$self->reflow;	2573	$self->reflow;
2380	}	2574	}
2381		2575
2382	sub size_allocate {	2576	sub size_allocate {
2383	my ($self, $w, $h, $changed) = @_;	2577	my ($self, $w, $h) = @_;
2384		2578
2385	$self->SUPER::size_allocate ($w, $h, $changed);	2579	$self->SUPER::size_allocate ($w, $h);
2386
2387	return unless $changed;
2388		2580
2389	$self->{layout}->set_font ($self->{font}) if $self->{font};	2581	$self->{layout}->set_font ($self->{font}) if $self->{font};
2390	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2582	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2391	$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});
2392		2585
2393	$self->reflow;	2586	$self->reflow;
2394	}	2587	}
2395		2588
2396	sub text_size {	2589	sub text_size {
…		…
2398		2591
2399	my $layout = $self->{layout};	2592	my $layout = $self->{layout};
2400		2593
2401	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2594	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2402	$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});
2403	$layout->set_markup ($text);	2597	$layout->set_markup ($text);
2404		2598
2405	$layout->size	2599	$layout->size
2406	}	2600	}
2407		2601
…		…
2446		2640
2447	return unless $self->{h} > 0;	2641	return unless $self->{h} > 0;
2448		2642
2449	delete $self->{texture};	2643	delete $self->{texture};
2450		2644
2451	$ROOT->on_post_alloc ($self, sub {	2645	$ROOT->on_post_alloc ($self => sub {
2452	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2646	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2453		2647
2454	if (delete $self->{need_reflow}) {	2648	if (delete $self->{need_reflow}) {
2455	my $height = 0;	2649	my $height = 0;
2456		2650
…		…
2459	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2653	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2460		2654
2461	for (@{$self->{par}}) {	2655	for (@{$self->{par}}) {
2462	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2656	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2463	$layout->set_width ($W - $_->[3]);	2657	$layout->set_width ($W - $_->[3]);
		2658	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2464	$layout->set_markup ($_->[4]);	2659	$layout->set_markup ($_->[4]);
2465	my ($w, $h) = $layout->size;	2660	my ($w, $h) = $layout->size;
2466	$_->[0] = $w + $_->[3];	2661	$_->[0] = $w + $_->[3];
2467	$_->[1] = $h;	2662	$_->[1] = $h;
2468	}	2663	}
…		…
2471	}	2666	}
2472		2667
2473	$self->{height} = $height;	2668	$self->{height} = $height;
2474		2669
2475	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2670	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2476		2671
2477	delete $self->{texture};	2672	delete $self->{texture};
2478	}	2673	}
2479		2674
2480	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2675	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2481	glClearColor 0.5, 0.5, 0.5, 0;	2676	glClearColor 0, 0, 0, 0;
2482	glClear GL_COLOR_BUFFER_BIT;	2677	glClear GL_COLOR_BUFFER_BIT;
2483		2678
2484	my $top = int $self->{children}[1]{range}[0];	2679	my $top = int $self->{children}[1]{range}[0];
2485		2680
2486	my $y0 = $top;	2681	my $y0 = $top;
…		…
2500	my $h = $par->[1];	2695	my $h = $par->[1];
2501		2696
2502	if ($y0 < $y + $h && $y < $y1) {	2697	if ($y0 < $y + $h && $y < $y1) {
2503	$layout->set_foreground (@{ $par->[2] });	2698	$layout->set_foreground (@{ $par->[2] });
2504	$layout->set_width ($W - $par->[3]);	2699	$layout->set_width ($W - $par->[3]);
		2700	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2505	$layout->set_markup ($par->[4]);	2701	$layout->set_markup ($par->[4]);
2506		2702
2507	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2703	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2508		2704
2509	glRasterPos $par->[3], $y - $y0;	2705	glRasterPos $par->[3], $y - $y0;
…		…
2521	sub _draw {	2717	sub _draw {
2522	my ($self) = @_;	2718	my ($self) = @_;
2523		2719
2524	glEnable GL_TEXTURE_2D;	2720	glEnable GL_TEXTURE_2D;
2525	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2721	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2526	glColor 1, 1, 1, 1;	2722	glColor 0, 0, 0, 1;
2527	$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});
2528	glDisable GL_TEXTURE_2D;	2724	glDisable GL_TEXTURE_2D;
2529		2725
2530	$self->{children}[1]->draw;	2726	$self->{children}[1]->draw;
2531		2727
2532	}	2728	}
…		…
2615	}	2811	}
2616		2812
2617	sub set_tooltip_from {	2813	sub set_tooltip_from {
2618	my ($self, $widget) = @_;	2814	my ($self, $widget) = @_;
2619		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
2620	$self->add (new CFClient::UI::Label	2828	$self->add (new CFClient::UI::Label
2621	markup => $widget->{tooltip},	2829	markup => $tooltip,
2622	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2830	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2623	fontsize => 0.8,	2831	fontsize => 0.8,
2624	fg => [0, 0, 0, 1],	2832	fg => [0, 0, 0, 1],
2625	ellipsise => 0,	2833	ellipsise => 0,
2626	font => ($widget->{tooltip_font} || $::FONT_PROP),	2834	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2634		2842
2635	($w + 4, $h + 4)	2843	($w + 4, $h + 4)
2636	}	2844	}
2637		2845
2638	sub size_allocate {	2846	sub size_allocate {
2639	my ($self, $w, $h, $changed) = @_;	2847	my ($self, $w, $h) = @_;
2640		2848
2641	return unless $changed;
2642
2643	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2849	$self->SUPER::size_allocate ($w - 4, $h - 4);
2644	}	2850	}
2645		2851
2646	sub visibility_change {	2852	sub visibility_change {
2647	my ($self, $visible) = @_;	2853	my ($self, $visible) = @_;
2648		2854
…		…
2653	or return;	2859	or return;
2654		2860
2655	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2861	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2656		2862
2657	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2863	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2658	if $x + $self->{w} > $::WIDTH;	2864	if $x + $self->{w} > $self->{root}{w};
2659		2865
2660	$self->move_abs ($x, $y);	2866	$self->move_abs ($x, $y);
2661	});	2867	});
2662	}	2868	}
2663		2869
…		…
2752	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2958	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2753		2959
2754	if ($tex) {	2960	if ($tex) {
2755	glEnable GL_TEXTURE_2D;	2961	glEnable GL_TEXTURE_2D;
2756	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2962	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2757	glColor 1, 1, 1, 1;	2963	glColor 0, 0, 0, 1;
2758	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2964	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2759	glDisable GL_TEXTURE_2D;	2965	glDisable GL_TEXTURE_2D;
2760	}	2966	}
2761	}	2967	}
2762		2968
2763	sub DESTROY {	2969	sub destroy {
2764	my ($self) = @_;	2970	my ($self) = @_;
2765		2971
2766	$self->{timer}->cancel	2972	$self->{timer}->cancel
2767	if $self->{timer};	2973	if $self->{timer};
2768		2974
2769	$self->SUPER::DESTROY;	2975	$self->SUPER::destroy;
2770	}	2976	}
2771		2977
2772	#############################################################################	2978	#############################################################################
2773		2979
2774	package CFClient::UI::Inventory;	2980	package CFClient::UI::Buttonbar;
2775		2981
2776	our @ISA = CFClient::UI::ScrolledWindow::;	2982	our @ISA = CFClient::UI::HBox::;
2777		2983
2778	sub new {	2984	# TODO: should actualyl wrap buttons and other goodies.
2779	my $class = shift;
2780
2781	my $self = $class->SUPER::new (
2782	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2783	@_,
2784	);
2785
2786	$self
2787	}
2788
2789	sub set_items {
2790	my ($self, $items) = @_;
2791
2792	$self->{scrolled}->clear;
2793	return unless $items;
2794
2795	my @items = sort {
2796	($a->{type} <=> $b->{type})
2797	or ($a->{name} cmp $b->{name})
2798	} @$items;
2799
2800	$self->{real_items} = \@items;
2801
2802	my $row = 0;
2803	for my $item (@items) {
2804	CFClient::Item::update_widgets $item;
2805
2806	$self->{scrolled}->add (0, $row, $item->{face_widget});
2807	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2808	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2809
2810	$row++;
2811	}
2812	}
2813		2985
2814	#############################################################################	2986	#############################################################################
2815		2987
2816	package CFClient::UI::Menu;	2988	package CFClient::UI::Menu;
2817		2989
…		…
2829	);	3001	);
2830		3002
2831	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3003	$self->add ($self->{vbox} = new CFClient::UI::VBox);
2832		3004
2833	for my $item (@{ $self->{items} }) {	3005	for my $item (@{ $self->{items} }) {
2834	my ($widget, $cb) = @$item;	3006	my ($widget, $cb, $tooltip) = @$item;
2835		3007
2836	# handle various types of items, only text for now	3008	# handle various types of items, only text for now
2837	if (!ref $widget) {	3009	if (!ref $widget) {
2838	$widget = new CFClient::UI::Label	3010	$widget = new CFClient::UI::Label
2839	can_hover => 1,	3011	can_hover => 1,
2840	can_events => 1,	3012	can_events => 1,
2841	text => $widget;	3013	markup => $widget,
		3014	tooltip => $tooltip
2842	}	3015	}
2843		3016
2844	$self->{item}{$widget} = $item;	3017	$self->{item}{$widget} = $item;
2845		3018
2846	$self->{vbox}->add ($widget);	3019	$self->{vbox}->add ($widget);
…		…
2858	# maybe save $GRAB? must be careful about events...	3031	# maybe save $GRAB? must be careful about events...
2859	$GRAB = $self;	3032	$GRAB = $self;
2860	$self->{button} = $ev->{button};	3033	$self->{button} = $ev->{button};
2861		3034
2862	$self->show;	3035	$self->show;
2863	$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);
2864	}	3037	}
2865		3038
2866	sub mouse_motion {	3039	sub mouse_motion {
2867	my ($self, $ev, $x, $y) = @_;	3040	my ($self, $ev, $x, $y) = @_;
2868		3041
2869	# TODO: should use vbox->find_widget or so	3042	# TODO: should use vbox->find_widget or so
2870	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3043	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2871	$self->{hover} = $self->{item}{$HOVER};	3044	$self->{hover} = $self->{item}{$HOVER};
		3045
		3046	0
2872	}	3047	}
2873		3048
2874	sub button_up {	3049	sub button_up {
2875	my ($self, $ev, $x, $y) = @_;	3050	my ($self, $ev, $x, $y) = @_;
2876		3051
…		…
2878	undef $GRAB;	3053	undef $GRAB;
2879	$self->hide;	3054	$self->hide;
2880		3055
2881	$self->_emit ("popdown");	3056	$self->_emit ("popdown");
2882	$self->{hover}[1]->() if $self->{hover};	3057	$self->{hover}[1]->() if $self->{hover};
		3058	} else {
		3059	return 0
		3060	}
		3061
2883	}	3062	1
2884	}	3063	}
2885		3064
2886	#############################################################################	3065	#############################################################################
2887		3066
2888	package CFClient::UI::Statusbox;	3067	package CFClient::UI::Multiplexer;
2889		3068
2890	our @ISA = CFClient::UI::VBox::;	3069	our @ISA = CFClient::UI::Container::;
2891		3070
2892	sub new {	3071	sub new {
2893	my $class = shift;	3072	my $class = shift;
2894		3073
2895	$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 (
2896	fontsize => 0.8,	3239	fontsize => 0.8,
2897	@_,	3240	@_,
2898	)	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
2899	}	3248	}
2900		3249
2901	sub reorder {	3250	sub reorder {
2902	my ($self) = @_;	3251	my ($self) = @_;
2903	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} };
2904		3258
2905	while (my ($k, $v) = each %{ $self->{item} }) {	3259	while (my ($k, $v) = each %{ $self->{item} }) {
2906	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3260	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2907	}	3261	}
2908		3262
…		…
2911	my @items = sort {	3265	my @items = sort {
2912	$a->{pri} <=> $b->{pri}	3266	$a->{pri} <=> $b->{pri}
2913	or $b->{id} <=> $a->{id}	3267	or $b->{id} <=> $a->{id}
2914	} values %{ $self->{item} };	3268	} values %{ $self->{item} };
2915		3269
		3270	$self->{timer}->interval (1);
		3271
2916	my $count = 10 + 1;	3272	my $count = 10 + 1;
2917	for my $item (@items) {	3273	for my $item (@items) {
2918	last unless --$count;	3274	last unless --$count;
2919		3275
2920	push @widgets, $item->{label} ||= do {	3276	my $label = $item->{label} ||= do {
2921	# TODO: doesn't handle markup well (read as: at all)	3277	# TODO: doesn't handle markup well (read as: at all)
2922	my $short = $item->{count} > 1	3278	my $short = $item->{count} > 1
2923	? "<b>$item->{count} ×</b> $item->{text}"	3279	? "<b>$item->{count} ×</b> $item->{text}"
2924	: $item->{text};	3280	: $item->{text};
2925		3281
…		…
2933	tooltip => $item->{tooltip},	3289	tooltip => $item->{tooltip},
2934	tooltip_font => $::FONT_PROP,	3290	tooltip_font => $::FONT_PROP,
2935	tooltip_width => 0.67,	3291	tooltip_width => 0.67,
2936	fontsize => $item->{fontsize} || $self->{fontsize},	3292	fontsize => $item->{fontsize} || $self->{fontsize},
2937	max_w => $::WIDTH * 0.44,	3293	max_w => $::WIDTH * 0.44,
2938	fg => $item->{fg},	3294	fg => [@{ $item->{fg} }],
2939	can_events => 1,	3295	can_events => 1,
2940	can_hover => 1	3296	can_hover => 1
2941	};	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;
2942	}	3310	}
2943		3311
2944	$self->clear;	3312	$self->clear;
2945	$self->SUPER::add (reverse @widgets);	3313	$self->SUPER::add (reverse @widgets);
2946	}	3314	}
…		…
2951	$text =~ s/^\s+//;	3319	$text =~ s/^\s+//;
2952	$text =~ s/\s+$//;	3320	$text =~ s/\s+$//;
2953		3321
2954	return unless $text;	3322	return unless $text;
2955		3323
2956	my $timeout = time + ((delete $arg{timeout}) || 60);	3324	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2957		3325
2958	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3326	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2959		3327
2960	if (my $item = $self->{item}{$group}) {	3328	if (my $item = $self->{item}{$group}) {
2961	if ($item->{text} eq $text) {	3329	if ($item->{text} eq $text) {
2962	$item->{count}++;	3330	$item->{count}++;
2963	} else {	3331	} else {
2964	$item->{count} = 1;	3332	$item->{count} = 1;
2965	$item->{text} = $item->{tooltip} = $text;	3333	$item->{text} = $item->{tooltip} = $text;
2966	}	3334	}
2967	$item->{id} = ++$self->{id};	3335	$item->{id} += 0.2;#d#
2968	$item->{timeout} = $timeout;	3336	$item->{timeout} = $timeout;
2969	delete $item->{label};	3337	delete $item->{label};
2970	} else {	3338	} else {
2971	$self->{item}{$group} = {	3339	$self->{item}{$group} = {
2972	id => ++$self->{id},	3340	id => ++$self->{id},
…		…
2991		3359
2992	$self->reorder;	3360	$self->reorder;
2993	$self->SUPER::reconfigure;	3361	$self->SUPER::reconfigure;
2994	}	3362	}
2995		3363
		3364	sub destroy {
		3365	my ($self) = @_;
		3366
		3367	$self->{timer}->cancel;
		3368
		3369	$self->SUPER::destroy;
		3370	}
		3371
2996	#############################################################################	3372	#############################################################################
2997		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) = @_;
		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	});
		3531	}
		3532
		3533	# $mod and $sym are the modifiers and key symbol
		3534	# $cmds is a array ref of strings (the commands)
		3535	# $cb is the callback that is executed on OK
		3536	# $ccb is the callback that is executed on CANCEL and
		3537	# when the binding was unsuccessful on OK
		3538	sub set_binding {
		3539	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3540
		3541	$self->clear_command_list;
		3542	$self->{recording} = 0;
		3543	$self->{rec_btn}->set_text ("start recording");
		3544
		3545	$self->{binding} = [$mod, $sym];
		3546	$self->{commands} = $cmds;
		3547
		3548	$self->{binding_change} = $cb;
		3549	$self->{binding_cancel} = $ccb;
		3550
		3551	$self->update_binding_widgets;
		3552	}
		3553
		3554	# this is a shortcut method that asks for a binding
		3555	# and then just binds it.
		3556	sub do_quick_binding {
		3557	my ($self, $cmds) = @_;
		3558	$self->set_binding (undef, undef, $cmds, sub {
		3559	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3560	});
		3561	$self->ask_for_bind (1);
		3562	}
		3563
		3564	sub update_binding_widgets {
		3565	my ($self) = @_;
		3566	my ($mod, $sym, $cmds) = $self->get_binding;
		3567	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3568	$self->set_command_list ($cmds);
		3569	}
		3570
		3571	sub get_binding {
		3572	my ($self) = @_;
		3573	return (
		3574	$self->{binding}->[0],
		3575	$self->{binding}->[1],
		3576	[ grep { defined $_ } @{$self->{commands}} ]
		3577	);
		3578	}
		3579
		3580	sub clear_command_list {
		3581	my ($self) = @_;
		3582	$self->{cmdbox}->clear ();
		3583	}
		3584
		3585	sub set_command_list {
		3586	my ($self, $cmds) = @_;
		3587
		3588	$self->{cmdbox}->clear ();
		3589	$self->{commands} = $cmds;
		3590
		3591	my $idx = 0;
		3592
		3593	for (@$cmds) {
		3594	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3595
		3596	my $i = $idx;
		3597	$hb->add (new CFClient::UI::Label text => $_);
		3598	$hb->add (new CFClient::UI::Button
		3599	text => "delete",
		3600	tooltip => "Deletes the action from the record",
		3601	on_activate => sub {
		3602	$self->{cmdbox}->remove ($hb);
		3603	$cmds->[$i] = undef;
		3604	});
		3605
		3606
		3607	$idx++
		3608	}
		3609	}
		3610
		3611	#############################################################################
		3612
		3613	package CFClient::UI::SpellList;
		3614
		3615	our @ISA = CFClient::UI::Table::;
		3616
		3617	sub new {
		3618	my $class = shift;
		3619
		3620	my $self = $class->SUPER::new (
		3621	binding => [],
		3622	commands => [],
		3623	@_,
		3624	)
		3625	}
		3626
		3627	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3628
		3629	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3630	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3631	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3632	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3633	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3634	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3635	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3636	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3637	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3638	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3639
		3640	sub rebuild_spell_list {
		3641	my ($self) = @_;
		3642
		3643	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3644	$self->clear;
		3645
		3646	return unless $::CONN;
		3647
		3648	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3649	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3650	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3651	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3652	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3653
		3654	my $row = 0;
		3655
		3656	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3657	my $spell = $self->{spell}{$_};
		3658
		3659	$row++;
		3660
		3661	my $spell_cb = sub {
		3662	my ($widget, $ev) = @_;
		3663
		3664	if ($ev->{button} == 1) {
		3665	$::CONN->user_send ("cast $spell->{name}");
		3666	} elsif ($ev->{button} == 2) {
		3667	$::CONN->user_send ("invoke $spell->{name}");
		3668	} elsif ($ev->{button} == 3) {
		3669	(new CFClient::UI::Menu
		3670	items => [
		3671	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3672	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3673	],
		3674	)->popup ($ev);
		3675	} else {
		3676	return 0;
		3677	}
		3678
		3679	1
		3680	};
		3681
		3682	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3683
		3684	#TODO: add path info to tooltip
		3685	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3686
		3687	$self->add (0, $row, new CFClient::UI::Face
		3688	face => $spell->{face},
		3689	can_hover => 1,
		3690	can_events => 1,
		3691	tooltip => $tooltip,
		3692	on_button_down => $spell_cb,
		3693	);
		3694
		3695	$self->add (1, $row, new CFClient::UI::Label
		3696	expand => 1,
		3697	text => $spell->{name},
		3698	can_hover => 1,
		3699	can_events => 1,
		3700	tooltip => $tooltip,
		3701	on_button_down => $spell_cb,
		3702	);
		3703
		3704	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3705	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3706	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3707	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3708	}
		3709	});
		3710	}
		3711
		3712	sub add_spell {
		3713	my ($self, $spell) = @_;
		3714
		3715	$self->{spell}->{$spell->{name}} = $spell;
		3716	$self->rebuild_spell_list;
		3717	}
		3718
		3719	sub remove_spell {
		3720	my ($self, $spell) = @_;
		3721
		3722	delete $self->{spell}->{$spell->{name}};
		3723	$self->rebuild_spell_list;
		3724	}
		3725
		3726	sub clear_spells {
		3727	my ($self) = @_;
		3728
		3729	$self->{spell} = {};
		3730	$self->rebuild_spell_list;
		3731	}
		3732
		3733	#############################################################################
		3734
2998	package CFClient::UI::Root;	3735	package CFClient::UI::Root;
2999		3736
3000	our @ISA = CFClient::UI::Container::;	3737	our @ISA = CFClient::UI::Container::;
		3738
		3739	use List::Util qw(min max);
3001		3740
3002	use CFClient::OpenGL;	3741	use CFClient::OpenGL;
3003		3742
3004	sub new {	3743	sub new {
3005	my $class = shift;	3744	my $class = shift;
…		…
3012	Scalar::Util::weaken ($self->{root} = $self);	3751	Scalar::Util::weaken ($self->{root} = $self);
3013		3752
3014	$self	3753	$self
3015	}	3754	}
3016		3755
3017	sub configure {
3018	my ($self, $x, $y, $w, $h) = @_;
3019
3020	$self->{w} = $w;
3021	$self->{h} = $h;
3022	}
3023
3024	sub reconfigure {
3025	my ($self) = @_;
3026
3027	$self->SUPER::reconfigure;
3028
3029	$self->size_allocate ($self->{w}, $self->{h}, 1)
3030	if $self->{w};
3031	}
3032
3033	sub size_request {	3756	sub size_request {
3034	my ($self) = @_;	3757	my ($self) = @_;
3035		3758
3036	($self->{w}, $self->{h})	3759	($self->{w}, $self->{h})
3037	}	3760	}
…		…
3049		3772
3050	int $coord + 0.5	3773	int $coord + 0.5
3051	}	3774	}
3052		3775
3053	sub size_allocate {	3776	sub size_allocate {
3054	my ($self, $w, $h, $changed) = @_;	3777	my ($self, $w, $h) = @_;
3055		3778
3056	for my $child ($self->children) {	3779	for my $child ($self->children) {
3057	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3780	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3058		3781
3059	$X = $child->{force_x} if exists $child->{force_x};	3782	$X = $child->{force_x} if exists $child->{force_x};
…		…
3127	$_->()	3850	$_->()
3128	for values %{delete $self->{refresh_hook}};	3851	for values %{delete $self->{refresh_hook}};
3129	}	3852	}
3130		3853
3131	if ($self->{realloc}) {	3854	if ($self->{realloc}) {
		3855	my %queue;
3132	my @queue;	3856	my @queue;
		3857	my $widget;
3133		3858
		3859	outer:
3134	while () {	3860	while () {
3135	if ($self->{realloc}) {	3861	if (my $realloc = delete $self->{realloc}) {
3136	#TODO use array-of-depth approach	3862	for $widget (values %$realloc) {
		3863	$widget->{visible} or next; # do not resize invisible widgets
3137		3864
3138	@queue = sort { $a->{visible} <=> $b->{visible} }	3865	$queue{$widget+0}++ and next; # duplicates are common
3139	@queue, values %{delete $self->{realloc}};	3866
		3867	push @{ $queue[$widget->{visible}] }, $widget;
		3868	}
3140	}	3869	}
3141		3870
		3871	while () {
		3872	@queue or last outer;
		3873
		3874	$widget = pop @{ $queue[-1] || [] }
		3875	and last;
		3876
		3877	pop @queue;
		3878	}
		3879
		3880	delete $queue{$widget+0};
		3881
		3882	my ($w, $h) = $widget->size_request;
		3883
		3884	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3885	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3886
		3887	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3888	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3889
		3890	$w = $widget->{force_w} if exists $widget->{force_w};
		3891	$h = $widget->{force_h} if exists $widget->{force_h};
		3892
		3893	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3894	|| delete $widget->{force_realloc}) {
		3895	$widget->{req_w} = $w;
		3896	$widget->{req_h} = $h;
		3897
		3898	$self->{size_alloc}{$widget+0} = $widget;
		3899
		3900	if (my $parent = $widget->{parent}) {
		3901	$self->{realloc}{$parent+0} = $parent
		3902	unless $queue{$parent+0};
		3903
		3904	$parent->{force_size_alloc} = 1;
		3905	$self->{size_alloc}{$parent+0} = $parent;
		3906	}
		3907	}
		3908
		3909	delete $self->{realloc}{$widget+0};
		3910	}
		3911	}
		3912
		3913	while (my $size_alloc = delete $self->{size_alloc}) {
		3914	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3915	values %$size_alloc;
		3916
		3917	while () {
3142	my $widget = pop @queue || last;	3918	my $widget = pop @queue || last;
3143		3919
3144	$widget->{visible} or last; # do not resize invisible widgets	3920	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3145
3146	my ($w, $h) = exists $widget->{force_w} && exists $widget->{force_h}
3147	? @$widget{qw(force_w force_h)}
3148	: $widget->size_request;
3149
3150	my $min_size = $widget->{is_toplevel} ? 16 : 0;
3151
3152	$w = $min_size if $w < $min_size;
3153	$h = $min_size if $h < $min_size;
3154
3155	$widget->{req_w} = $w;
3156	$widget->{req_h} = $h;
3157
3158	$self->{size_alloc}{$widget} = [$widget, undef, undef];
3159
3160	push @queue, $widget->{parent}
3161	if $widget->{parent};
3162	}
3163	}
3164
3165	while (my $size_alloc = delete $self->{size_alloc}) {
3166	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},
3167	values %$size_alloc;
3168
3169	while () {
3170	my ($widget, $w, $h) = @{ pop @queue or last };
3171
3172	$w = $widget->{w} || $widget->{req_w} unless defined $w;
3173	$h = $widget->{h} || $widget->{req_h} unless defined $h;
3174		3921
3175	$w = 0 if $w < 0;	3922	$w = 0 if $w < 0;
3176	$h = 0 if $h < 0;	3923	$h = 0 if $h < 0;
3177		3924
3178	$w = int $w + 0.5;	3925	$w = int $w + 0.5;
3179	$h = int $h + 0.5;	3926	$h = int $h + 0.5;
3180		3927
3181	my $changed = $widget->{w} != $w || $widget->{h} != $h;	3928	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3929	$widget->{old_w} = $widget->{w};
		3930	$widget->{old_h} = $widget->{h};
3182		3931
3183	$widget->{w} = $w;	3932	$widget->{w} = $w;
3184	$widget->{h} = $h;	3933	$widget->{h} = $h;
3185		3934
3186	$widget->emit (size_allocate => $w, $h, $changed);	3935	$widget->emit (size_allocate => $w, $h);
		3936	}
3187	}	3937	}
3188	}	3938	}
3189		3939
3190	while ($self->{post_alloc_hook}) {	3940	while ($self->{post_alloc_hook}) {
3191	$_->()	3941	$_->()
3192	for values %{delete $self->{post_alloc_hook}};	3942	for values %{delete $self->{post_alloc_hook}};
3193	}	3943	}
		3944
3194		3945
3195	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3946	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3196	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3947	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3197	glClear GL_COLOR_BUFFER_BIT;	3948	glClear GL_COLOR_BUFFER_BIT;
3198		3949
…		…
3200	glLoadIdentity;	3951	glLoadIdentity;
3201	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3952	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3202	glMatrixMode GL_MODELVIEW;	3953	glMatrixMode GL_MODELVIEW;
3203	glLoadIdentity;	3954	glLoadIdentity;
3204		3955
		3956	{
		3957	package CFClient::UI::Base;
		3958
		3959	($draw_x, $draw_y, $draw_w, $draw_h) =
		3960	(0, 0, $self->{w}, $self->{h});
		3961	}
		3962
3205	$self->_draw;	3963	$self->_draw;
3206	}	3964	}
3207		3965
3208	#############################################################################	3966	#############################################################################
3209		3967

Diff Legend

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