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.302 by root, Mon Jun 12 13:26:14 2006 UTC vs.
Revision 1.438 by root, Sat Sep 1 07:22:21 2007 UTC

1	package CFClient::UI;	1	package CFPlus::UI;
2		2
3	use utf8;	3	use utf8;
4	use strict;	4	use strict;
5		5
6	use Scalar::Util ();
7	use List::Util ();	6	use List::Util ();
8	use Event;	7	use Event;
9		8
10	use CFClient;	9	use CFPlus;
		10	use CFPlus::Pod;
11	use CFClient::Texture;	11	use CFPlus::Texture;
12		12
13	our ($FOCUS, $HOVER, $GRAB); # various widgets	13	our ($FOCUS, $HOVER, $GRAB); # various widgets
14		14
15	our $LAYOUT;	15	our $LAYOUT;
16	our $ROOT;	16	our $ROOT;
…		…
22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {	22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
23	if (!$GRAB) {	23	if (!$GRAB) {
24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
25	if (length $widget->{tooltip}) {	25	if (length $widget->{tooltip}) {
26	if ($TOOLTIP->{owner} != $widget) {	26	if ($TOOLTIP->{owner} != $widget) {
		27	$TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
27	$TOOLTIP->hide;	28	$TOOLTIP->hide;
28		29
29	$TOOLTIP->{owner} = $widget;	30	$TOOLTIP->{owner} = $widget;
		31	$TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner};
30		32
31	return if $ENV{CFPLUS_DEBUG} & 8;	33	return if $ENV{CFPLUS_DEBUG} & 8;
32		34
33	my $tip = $widget->{tooltip};
34
35	$tip = $tip->($widget) if CODE:: eq ref $tip;
36
37	$TOOLTIP->set_tooltip_from ($widget);	35	$TOOLTIP->set_tooltip_from ($widget);
38	$TOOLTIP->show;	36	$TOOLTIP->show;
39	}	37	}
40		38
41	return;	39	return;
42	}	40	}
43	}	41	}
44	}	42	}
45		43
46	$TOOLTIP->hide;	44	$TOOLTIP->hide;
		45	$TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
47	delete $TOOLTIP->{owner};	46	delete $TOOLTIP->{owner};
48	});	47	});
49		48
50	sub get_layout {	49	sub get_layout {
51	my $layout;	50	my $layout;
…		…
79	sub feed_sdl_key_up_event {	78	sub feed_sdl_key_up_event {
80	$FOCUS->emit (key_up => $_[0])	79	$FOCUS->emit (key_up => $_[0])
81	if $FOCUS;	80	if $FOCUS;
82	}	81	}
83		82
		83	sub check_hover {
		84	my ($widget) = @_;
		85
		86	if ($widget != $HOVER) {
		87	my $hover = $HOVER; $HOVER = $widget;
		88
		89	$hover->update if $hover && $hover->{can_hover};
		90	$HOVER->update if $HOVER && $HOVER->{can_hover};
		91
		92	$TOOLTIP_WATCHER->start;
		93	}
		94	}
		95
84	sub feed_sdl_button_down_event {	96	sub feed_sdl_button_down_event {
85	my ($ev) = @_;	97	my ($ev) = @_;
86	my ($x, $y) = ($ev->{x}, $ev->{y});	98	my ($x, $y) = ($ev->{x}, $ev->{y});
87		99
88	if (!$BUTTON_STATE) {	100	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
		101
		102	unless ($GRAB) {
89	my $widget = $ROOT->find_widget ($x, $y);	103	my $widget = $ROOT->find_widget ($x, $y);
90		104
91	$GRAB = $widget;	105	$GRAB = $widget;
92	$GRAB->update if $GRAB;	106	$GRAB->update if $GRAB;
93		107
94	$TOOLTIP_WATCHER->cb->();	108	$TOOLTIP_WATCHER->cb->();
95	}	109	}
96		110
97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	111	if ($GRAB) {
		112	if ($ev->{button} == 4 || $ev->{button} == 5) {
		113	# mousewheel
		114	my $delta = $ev->{button} * 2 - 9;
		115	my $shift = $ev->{mod} & CFPlus::KMOD_SHIFT;
98		116
99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	117	$ev->{dx} = $shift ? $delta : 0;
100	if $GRAB;	118	$ev->{dy} = $shift ? 0 : $delta;
		119
		120	$GRAB->emit (mouse_wheel => $ev);
		121	} else {
		122	$GRAB->emit (button_down => $ev)
		123	}
		124	}
101	}	125	}
102		126
103	sub feed_sdl_button_up_event {	127	sub feed_sdl_button_up_event {
104	my ($ev) = @_;	128	my ($ev) = @_;
105	my ($x, $y) = ($ev->{x}, $ev->{y});
106		129
107	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	130	my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
108		131
109	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	132	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
110		133
111	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))	134	$GRAB->emit (button_up => $ev)
112	if $GRAB;	135	if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
113		136
114	if (!$BUTTON_STATE) {	137	unless ($BUTTON_STATE) {
115	my $grab = $GRAB; undef $GRAB;	138	my $grab = $GRAB; undef $GRAB;
116	$grab->update if $grab;	139	$grab->update if $grab;
117	$GRAB->update if $GRAB;	140	$GRAB->update if $GRAB;
118		141
		142	check_hover $widget;
119	$TOOLTIP_WATCHER->cb->();	143	$TOOLTIP_WATCHER->cb->();
120	}	144	}
121	}	145	}
122		146
123	sub feed_sdl_motion_event {	147	sub feed_sdl_motion_event {
124	my ($ev) = @_;	148	my ($ev) = @_;
125	my ($x, $y) = ($ev->{x}, $ev->{y});	149	my ($x, $y) = ($ev->{x}, $ev->{y});
126		150
127	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	151	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
128		152
129	if ($widget != $HOVER) {	153	check_hover $widget;
130	my $hover = $HOVER; $HOVER = $widget;
131		154
132	$hover->update if $hover && $hover->{can_hover};	155	$HOVER->emit (mouse_motion => $ev)
133	$HOVER->update if $HOVER && $HOVER->{can_hover};
134
135	$TOOLTIP_WATCHER->start;
136	}
137
138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
139	if $HOVER;	156	if $HOVER;
140	}	157	}
141		158
142	# convert position array to integers	159	# convert position array to integers
143	sub harmonize {	160	sub harmonize {
…		…
193	reconfigure_widgets;	210	reconfigure_widgets;
194	}	211	}
195		212
196	#############################################################################	213	#############################################################################
197		214
		215	package CFPlus::UI::Event;
		216
		217	sub xy {
		218	$_[1]->coord2local ($_[0]{x}, $_[0]{y})
		219	}
		220
		221	#############################################################################
		222
198	package CFClient::UI::Base;	223	package CFPlus::UI::Base;
199		224
200	use strict;	225	use strict;
201		226
202	use CFClient::OpenGL;	227	use CFPlus::OpenGL;
203		228
204	sub new {	229	sub new {
205	my $class = shift;	230	my $class = shift;
206		231
207	my $self = bless {	232	my $self = bless {
…		…
212	h => undef,	237	h => undef,
213	can_events => 1,	238	can_events => 1,
214	@_	239	@_
215	}, $class;	240	}, $class;
216		241
217	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);	242	CFPlus::weaken ($CFPlus::UI::WIDGET{$self+0} = $self);
218		243
219	for (keys %$self) {	244	for (keys %$self) {
220	if (/^on_(.*)$/) {	245	if (/^on_(.*)$/) {
221	$self->connect ($1 => delete $self->{$_});	246	$self->connect ($1 => delete $self->{$_});
222	}	247	}
223	}	248	}
224		249
225	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {	250	if (my $layout = $CFPlus::UI::LAYOUT->{$self->{name}}) {
226	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};	251	$self->{x} = $layout->{x} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{x};
227	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};	252	$self->{y} = $layout->{y} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{y};
228	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};	253	$self->{force_w} = $layout->{w} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{w};
229	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};	254	$self->{force_h} = $layout->{h} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{h};
230		255
231	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};	256	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
232	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};	257	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
233		258
234	$self->show if $layout->{show};	259	$self->show if $layout->{show};
…		…
239		264
240	sub destroy {	265	sub destroy {
241	my ($self) = @_;	266	my ($self) = @_;
242		267
243	$self->hide;	268	$self->hide;
		269	$self->emit ("destroy");
244	%$self = ();	270	%$self = ();
245	}	271	}
246		272
		273	sub TO_JSON {
		274	{ "\fw" => $_[0]{s_id} }
		275	}
		276
247	sub show {	277	sub show {
248	my ($self) = @_;	278	my ($self) = @_;
249		279
250	return if $self->{parent};	280	return if $self->{parent};
251		281
252	$CFClient::UI::ROOT->add ($self);	282	$CFPlus::UI::ROOT->add ($self);
253	}	283	}
254		284
255	sub set_visible {	285	sub set_visible {
256	my ($self) = @_;	286	my ($self) = @_;
257		287
…		…
278	delete $self->{root};	308	delete $self->{root};
279		309
280	undef $GRAB if $GRAB == $self;	310	undef $GRAB if $GRAB == $self;
281	undef $HOVER if $HOVER == $self;	311	undef $HOVER if $HOVER == $self;
282		312
283	$CFClient::UI::TOOLTIP_WATCHER->cb->()	313	$CFPlus::UI::TOOLTIP_WATCHER->cb->()
284	if $TOOLTIP->{owner} == $self;	314	if $TOOLTIP->{owner} == $self;
285		315
286	$self->focus_out;	316	$self->emit ("focus_out");
287
288	$self->emit (visibility_change => 0);	317	$self->emit (visibility_change => 0);
289	}	318	}
290		319
291	sub set_visibility {	320	sub set_visibility {
292	my ($self, $visible) = @_;	321	my ($self, $visible) = @_;
293		322
294	return if $self->{visible} == $visible;	323	return if $self->{visible} == $visible;
295		324
296	$visible ? $self->hide	325	$visible ? $self->show
297	: $self->show;	326	: $self->hide;
298	}	327	}
299		328
300	sub toggle_visibility {	329	sub toggle_visibility {
301	my ($self) = @_;	330	my ($self) = @_;
302		331
…		…
336	sub size_request {	365	sub size_request {
337	require Carp;	366	require Carp;
338	Carp::confess "size_request is abstract";	367	Carp::confess "size_request is abstract";
339	}	368	}
340		369
		370	sub baseline_shift {
		371	0
		372	}
		373
341	sub configure {	374	sub configure {
342	my ($self, $x, $y, $w, $h) = @_;	375	my ($self, $x, $y, $w, $h) = @_;
343		376
344	if ($self->{aspect}) {	377	if ($self->{aspect}) {
345	my ($ow, $oh) = ($w, $h);	378	my ($ow, $oh) = ($w, $h);
346		379
347	$w = List::Util::min $w, int $h * $self->{aspect};	380	$w = List::Util::min $w, CFPlus::ceil $h * $self->{aspect};
348	$h = List::Util::min $h, int $w / $self->{aspect};	381	$h = List::Util::min $h, CFPlus::ceil $w / $self->{aspect};
349		382
350	# use alignment to adjust x, y	383	# use alignment to adjust x, y
351		384
352	$x += int 0.5 * ($ow - $w);	385	$x += int 0.5 * ($ow - $w);
353	$y += int 0.5 * ($oh - $h);	386	$y += int 0.5 * ($oh - $h);
…		…
367		400
368	$self->{root}{size_alloc}{$self+0} = $self;	401	$self->{root}{size_alloc}{$self+0} = $self;
369	}	402	}
370	}	403	}
371		404
372	sub size_allocate {
373	# nothing to be done
374	}
375
376	sub children {	405	sub children {
377	# nop	406	# nop
378	}	407	}
379		408
380	sub visible_children {	409	sub visible_children {
…		…
398		427
399	return if $self->{tooltip} eq $tooltip;	428	return if $self->{tooltip} eq $tooltip;
400		429
401	$self->{tooltip} = $tooltip;	430	$self->{tooltip} = $tooltip;
402		431
403	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	432	if ($CFPlus::UI::TOOLTIP->{owner} == $self) {
404	delete $CFClient::UI::TOOLTIP->{owner};	433	delete $CFPlus::UI::TOOLTIP->{owner};
405	$CFClient::UI::TOOLTIP_WATCHER->cb->();	434	$CFPlus::UI::TOOLTIP_WATCHER->cb->();
406	}	435	}
407	}	436	}
408		437
409	# translate global coordinates to local coordinate system	438	# translate global coordinates to local coordinate system
410	sub coord2local {	439	sub coord2local {
411	my ($self, $x, $y) = @_;	440	my ($self, $x, $y) = @_;
412		441
		442	Carp::confess unless $self->{parent};#d#
		443
413	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})	444	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
414	}	445	}
415		446
416	# translate local coordinates to global coordinate system	447	# translate local coordinates to global coordinate system
417	sub coord2global {	448	sub coord2global {
418	my ($self, $x, $y) = @_;	449	my ($self, $x, $y) = @_;
419		450
		451	Carp::confess unless $self->{parent};#d#
		452
420	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	453	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421	}	454	}
422		455
423	sub focus_in {	456	sub invoke_focus_in {
424	my ($self) = @_;	457	my ($self) = @_;
425		458
426	return if $FOCUS == $self;	459	return if $FOCUS == $self;
427	return unless $self->{can_focus};	460	return unless $self->{can_focus};
428		461
429	my $focus = $FOCUS; $FOCUS = $self;	462	$FOCUS = $self;
430		463
431	$self->_emit (focus_in => $focus);	464	$self->update;
432		465
433	$focus->update if $focus;	466	0
434	$FOCUS->update;
435	}	467	}
436		468
437	sub focus_out {	469	sub invoke_focus_out {
438	my ($self) = @_;	470	my ($self) = @_;
439		471
440	return unless $FOCUS == $self;	472	return unless $FOCUS == $self;
441		473
442	my $focus = $FOCUS; undef $FOCUS;	474	undef $FOCUS;
443		475
444	$self->_emit (focus_out => $focus);	476	$self->update;
445		477
446	$focus->update if $focus; #?
447
448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	478	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449	unless $FOCUS;	479	unless $FOCUS;
450	}
451		480
		481	0
		482	}
		483
		484	sub grab_focus {
		485	my ($self) = @_;
		486
		487	$FOCUS->emit ("focus_out") if $FOCUS;
		488	$self->emit ("focus_in");
		489	}
		490
452	sub mouse_motion { 0 }	491	sub invoke_mouse_motion { 0 }
453	sub button_up { 0 }	492	sub invoke_button_up { 0 }
454	sub key_down { 0 }	493	sub invoke_key_down { 0 }
455	sub key_up { 0 }	494	sub invoke_key_up { 0 }
		495	sub invoke_mouse_wheel { 0 }
456		496
457	sub button_down {	497	sub invoke_button_down {
458	my ($self, $ev, $x, $y) = @_;	498	my ($self, $ev, $x, $y) = @_;
459		499
460	$self->focus_in;	500	$self->grab_focus;
461		501
462	0	502	0
463	}	503	}
464		504
		505	sub connect {
		506	my ($self, $signal, $cb) = @_;
		507
		508	push @{ $self->{signal_cb}{$signal} }, $cb;
		509
		510	defined wantarray and CFPlus::guard {
		511	@{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
		512	@{ $self->{signal_cb}{$signal} };
		513	}
		514	}
		515
		516	sub disconnect_all {
		517	my ($self, $signal) = @_;
		518
		519	delete $self->{signal_cb}{$signal};
		520	}
		521
		522	my %has_coords = (
		523	button_down => 1,
		524	button_up => 1,
		525	mouse_motion => 1,
		526	mouse_wheel => 1,
		527	);
		528
		529	sub emit {
		530	my ($self, $signal, @args) = @_;
		531
		532	# I do not really like this solution, but I do not like duplication
		533	# and needlessly verbose code, either.
		534	my @append
		535	= $has_coords{$signal}
		536	? $args[0]->xy ($self)
		537	: ();
		538
		539	#warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
		540
		541	for my $cb (
		542	@{$self->{signal_cb}{$signal} || []}, # before
		543	($self->can ("invoke_$signal") || sub { 1 }), # closure
		544	) {
		545	return $cb->($self, @args, @append) || next;
		546	}
		547
		548	# parent
		549	$self->{parent} && $self->{parent}->emit ($signal, @args)
		550	}
		551
465	sub find_widget {	552	#sub find_widget {
466	my ($self, $x, $y) = @_;	553	# in .xs
467
468	return () unless $self->{can_events};
469
470	return $self
471	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
472	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
473
474	()
475	}
476		554
477	sub set_parent {	555	sub set_parent {
478	my ($self, $parent) = @_;	556	my ($self, $parent) = @_;
479		557
480	Scalar::Util::weaken ($self->{parent} = $parent);	558	CFPlus::weaken ($self->{parent} = $parent);
481	$self->set_visible if $parent->{visible};	559	$self->set_visible if $parent->{visible};
482	}
483
484	sub connect {
485	my ($self, $signal, $cb) = @_;
486
487	push @{ $self->{signal_cb}{$signal} }, $cb;
488	}
489
490	sub _emit {
491	my ($self, $signal, @args) = @_;
492
493	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
494	}
495
496	sub emit {
497	my ($self, $signal, @args) = @_;
498
499	$self->_emit ($signal, @args)
500	|| $self->$signal (@args);
501	}
502
503	sub visibility_change {
504	#my ($self, $visible) = @_;
505	}	560	}
506		561
507	sub realloc {	562	sub realloc {
508	my ($self) = @_;	563	my ($self) = @_;
509		564
…		…
534		589
535	# using global variables seems a bit hacky, but passing through all drawing	590	# using global variables seems a bit hacky, but passing through all drawing
536	# functions seems pointless.	591	# functions seems pointless.
537	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn	592	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
538		593
539	sub draw {	594	#sub draw {
540	my ($self) = @_;	595	#CFPlus.xs
541
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);
553
554	glPushMatrix;
555	glTranslate $self->{x}, $self->{y}, 0;
556
557	if ($self == $HOVER && $self->{can_hover}) {
558	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
559	glEnable GL_BLEND;
560	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
561	glBegin GL_QUADS;
562	glVertex 0 , 0;
563	glVertex $self->{w}, 0;
564	glVertex $self->{w}, $self->{h};
565	glVertex 0 , $self->{h};
566	glEnd;
567	glDisable GL_BLEND;
568	}
569
570	if ($ENV{CFPLUS_DEBUG} & 1) {
571	glPushMatrix;
572	glColor 1, 1, 0, 1;
573	glTranslate 0.375, 0.375;
574	glBegin GL_LINE_LOOP;
575	glVertex 0 , 0;
576	glVertex $self->{w} - 1, 0;
577	glVertex $self->{w} - 1, $self->{h} - 1;
578	glVertex 0 , $self->{h} - 1;
579	glEnd;
580	glPopMatrix;
581	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
582	}
583
584	$self->_draw;
585	glPopMatrix;
586	}
587		596
588	sub _draw {	597	sub _draw {
589	my ($self) = @_;	598	my ($self) = @_;
590		599
591	warn "no draw defined for $self\n";	600	warn "no draw defined for $self\n";
592	}	601	}
593		602
594	sub DESTROY {	603	sub DESTROY {
595	my ($self) = @_;	604	my ($self) = @_;
596		605
597	delete $WIDGET{$self+0};	606	return if CFPlus::in_destruct;
598		607
		608	local $@;
599	eval { $self->destroy };	609	eval { $self->destroy };
600	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;	610	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
		611
		612	delete $WIDGET{$self+0};
601	}	613	}
602		614
603	#############################################################################	615	#############################################################################
604		616
605	package CFClient::UI::DrawBG;	617	package CFPlus::UI::DrawBG;
606		618
607	our @ISA = CFClient::UI::Base::;	619	our @ISA = CFPlus::UI::Base::;
608		620
609	use strict;	621	use strict;
610	use CFClient::OpenGL;	622	use CFPlus::OpenGL;
611		623
612	sub new {	624	sub new {
613	my $class = shift;	625	my $class = shift;
614
615	# range [value, low, high, page]
616		626
617	$class->SUPER::new (	627	$class->SUPER::new (
618	#bg => [0, 0, 0, 0.2],	628	#bg => [0, 0, 0, 0.2],
619	#active_bg => [1, 1, 1, 0.5],	629	#active_bg => [1, 1, 1, 0.5],
620	@_	630	@_
…		…
632	my ($w, $h) = @$self{qw(w h)};	642	my ($w, $h) = @$self{qw(w h)};
633		643
634	glEnable GL_BLEND;	644	glEnable GL_BLEND;
635	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	645	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
636	glColor_premultiply @$color;	646	glColor_premultiply @$color;
637
638	glBegin GL_QUADS;
639	glVertex 0 , 0;
640	glVertex 0 , $h;
641	glVertex $w, $h;	647	glRect 0, 0, $w, $h;
642	glVertex $w, 0;
643	glEnd;
644
645	glDisable GL_BLEND;	648	glDisable GL_BLEND;
646	}	649	}
647	}	650	}
648		651
649	#############################################################################	652	#############################################################################
650		653
651	package CFClient::UI::Empty;	654	package CFPlus::UI::Empty;
652		655
653	our @ISA = CFClient::UI::Base::;	656	our @ISA = CFPlus::UI::Base::;
654		657
655	sub new {	658	sub new {
656	my ($class, %arg) = @_;	659	my ($class, %arg) = @_;
657	$class->SUPER::new (can_events => 0, %arg);	660	$class->SUPER::new (can_events => 0, %arg);
658	}	661	}
…		…
665		668
666	sub draw { }	669	sub draw { }
667		670
668	#############################################################################	671	#############################################################################
669		672
670	package CFClient::UI::Container;	673	package CFPlus::UI::Container;
671		674
672	our @ISA = CFClient::UI::Base::;	675	our @ISA = CFPlus::UI::Base::;
673		676
674	sub new {	677	sub new {
675	my ($class, %arg) = @_;	678	my ($class, %arg) = @_;
676		679
677	my $children = delete $arg{children};	680	my $children = delete $arg{children};
…		…
681	can_events => 0,	684	can_events => 0,
682	%arg,	685	%arg,
683	);	686	);
684		687
685	$self->add (@$children)	688	$self->add (@$children)
686	if $children;	689	if $children && @$children;
687		690
688	$self	691	$self
		692	}
		693
		694	sub realloc {
		695	my ($self) = @_;
		696
		697	$self->{force_realloc} = 1;
		698	$self->{force_size_alloc} = 1;
		699	$self->SUPER::realloc;
689	}	700	}
690		701
691	sub add {	702	sub add {
692	my ($self, @widgets) = @_;	703	my ($self, @widgets) = @_;
693		704
694	$_->set_parent ($self)	705	$_->set_parent ($self)
695	for @widgets;	706	for @widgets;
696		707
		708	# TODO: only do this in widgets that need it, e.g. root, fixed
697	use sort 'stable';	709	use sort 'stable';
698		710
699	$self->{children} = [	711	$self->{children} = [
700	sort { $a->{z} <=> $b->{z} }	712	sort { $a->{z} <=> $b->{z} }
701	@{$self->{children}}, @widgets	713	@{$self->{children}}, @widgets
702	];	714	];
703		715
704	$self->realloc;	716	$self->realloc;
		717
		718	$self->emit (c_add => \@widgets);
		719
		720	map $_+0, @widgets
705	}	721	}
706		722
707	sub children {	723	sub children {
708	@{ $_[0]{children} }	724	@{ $_[0]{children} }
709	}	725	}
710		726
711	sub remove {	727	sub remove {
712	my ($self, $child) = @_;	728	my ($self, @widgets) = @_;
713		729
		730	$self->emit (c_remove => \@widgets);
		731
		732	for my $child (@widgets) {
714	delete $child->{parent};	733	delete $child->{parent};
715	$child->hide;	734	$child->hide;
716
717	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	735	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
		736	}
718		737
719	$self->realloc;	738	$self->realloc;
720	}	739	}
721		740
722	sub clear {	741	sub clear {
723	my ($self) = @_;	742	my ($self) = @_;
724		743
725	my $children = delete $self->{children};	744	my $children = $self->{children};
726	$self->{children} = [];	745	$self->{children} = [];
727		746
728	for (@$children) {	747	for (@$children) {
729	delete $_->{parent};	748	delete $_->{parent};
730	$_->hide;	749	$_->hide;
…		…
750	}	769	}
751		770
752	sub _draw {	771	sub _draw {
753	my ($self) = @_;	772	my ($self) = @_;
754		773
755	$_->draw for @{$self->{children}};	774	$_->draw for $self->visible_children;
756	}	775	}
757		776
758	#############################################################################	777	#############################################################################
759		778
760	package CFClient::UI::Bin;	779	package CFPlus::UI::Bin;
761		780
762	our @ISA = CFClient::UI::Container::;	781	our @ISA = CFPlus::UI::Container::;
763		782
764	sub new {	783	sub new {
765	my ($class, %arg) = @_;	784	my ($class, %arg) = @_;
766		785
767	my $child = (delete $arg{child}) || new CFClient::UI::Empty::;	786	my $child = (delete $arg{child}) || new CFPlus::UI::Empty::;
768		787
769	$class->SUPER::new (children => [$child], %arg)	788	$class->SUPER::new (children => [$child], %arg)
770	}	789	}
771		790
772	sub add {	791	sub add {
773	my ($self, $child) = @_;	792	my ($self, $child) = @_;
774		793
775	$self->SUPER::remove ($_) for @{ $self->{children} };	794	$self->clear;
776	$self->SUPER::add ($child);	795	$self->SUPER::add ($child);
777	}	796	}
778		797
779	sub remove {	798	sub remove {
780	my ($self, $widget) = @_;	799	my ($self, $widget) = @_;
781		800
782	$self->SUPER::remove ($widget);	801	$self->SUPER::remove ($widget);
783		802
784	$self->{children} = [new CFClient::UI::Empty]	803	$self->{children} = [new CFPlus::UI::Empty]
785	unless @{$self->{children}};	804	unless @{$self->{children}};
786	}	805	}
787		806
788	sub child { $_[0]->{children}[0] }	807	sub child { $_[0]->{children}[0] }
789		808
790	sub size_request {	809	sub size_request {
791	$_[0]{children}[0]->size_request	810	$_[0]{children}[0]->size_request
792	}	811	}
793		812
794	sub size_allocate {	813	sub invoke_size_allocate {
795	my ($self, $w, $h) = @_;	814	my ($self, $w, $h) = @_;
796		815
797	$self->{children}[0]->configure (0, 0, $w, $h);	816	$self->{children}[0]->configure (0, 0, $w, $h);
		817
		818	1
798	}	819	}
799		820
800	#############################################################################	821	#############################################################################
801		822
802	# back-buffered drawing area	823	# back-buffered drawing area
803		824
804	package CFClient::UI::Window;	825	package CFPlus::UI::Window;
805		826
806	our @ISA = CFClient::UI::Bin::;	827	our @ISA = CFPlus::UI::Bin::;
807		828
808	use CFClient::OpenGL;	829	use CFPlus::OpenGL;
809		830
810	sub new {	831	sub new {
811	my ($class, %arg) = @_;	832	my ($class, %arg) = @_;
812		833
813	my $self = $class->SUPER::new (%arg);	834	my $self = $class->SUPER::new (%arg);
…		…
818		839
819	$ROOT->on_post_alloc ($self => sub { $self->render_child });	840	$ROOT->on_post_alloc ($self => sub { $self->render_child });
820	$self->SUPER::update;	841	$self->SUPER::update;
821	}	842	}
822		843
823	sub size_allocate {	844	sub invoke_size_allocate {
824	my ($self, $w, $h) = @_;	845	my ($self, $w, $h) = @_;
825		846
826	$self->SUPER::size_allocate ($w, $h);
827	$self->update;	847	$self->update;
		848
		849	$self->SUPER::invoke_size_allocate ($w, $h)
828	}	850	}
829		851
830	sub _render {	852	sub _render {
831	my ($self) = @_;	853	my ($self) = @_;
832		854
…		…
834	}	856	}
835		857
836	sub render_child {	858	sub render_child {
837	my ($self) = @_;	859	my ($self) = @_;
838		860
839	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	861	$self->{texture} = new_from_opengl CFPlus::Texture $self->{w}, $self->{h}, sub {
840	glClearColor 0, 0, 0, 0;	862	glClearColor 0, 0, 0, 0;
841	glClear GL_COLOR_BUFFER_BIT;	863	glClear GL_COLOR_BUFFER_BIT;
842		864
843	{	865	{
844	package CFClient::UI::Base;	866	package CFPlus::UI::Base;
845		867
846	($draw_x, $draw_y, $draw_w, $draw_h) =	868	local ($draw_x, $draw_y, $draw_w, $draw_h) =
847	(0, 0, $self->{w}, $self->{h});	869	(0, 0, $self->{w}, $self->{h});
		870
		871	$self->_render;
848	}	872	}
849
850	$self->_render;
851	};	873	};
852	}	874	}
853		875
854	sub _draw {	876	sub _draw {
855	my ($self) = @_;	877	my ($self) = @_;
856
857	my ($w, $h) = @$self{qw(w h)};
858		878
859	my $tex = $self->{texture}	879	my $tex = $self->{texture}
860	or return;	880	or return;
861		881
862	glEnable GL_TEXTURE_2D;	882	glEnable GL_TEXTURE_2D;
863	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	883	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
864	glColor 0, 0, 0, 1;	884	glColor 0, 0, 0, 1;
865		885
866	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	886	$tex->draw_quad_alpha_premultiplied (0, 0);
867		887
868	glDisable GL_TEXTURE_2D;	888	glDisable GL_TEXTURE_2D;
869	}	889	}
870		890
871	#############################################################################	891	#############################################################################
872		892
873	package CFClient::UI::ViewPort;	893	package CFPlus::UI::ViewPort;
874		894
		895	use List::Util qw(min max);
		896
875	our @ISA = CFClient::UI::Window::;	897	our @ISA = CFPlus::UI::Window::;
876		898
877	sub new {	899	sub new {
878	my $class = shift;	900	my $class = shift;
879		901
880	$class->SUPER::new (	902	$class->SUPER::new (
…		…
887	sub size_request {	909	sub size_request {
888	my ($self) = @_;	910	my ($self) = @_;
889		911
890	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	912	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
891		913
892	$w = 10 if $self->{scroll_x};	914	$w = 1 if $self->{scroll_x};
893	$h = 10 if $self->{scroll_y};	915	$h = 1 if $self->{scroll_y};
894		916
895	($w, $h)	917	($w, $h)
896	}	918	}
897		919
898	sub size_allocate {	920	sub invoke_size_allocate {
899	my ($self, $w, $h) = @_;	921	my ($self, $w, $h) = @_;
900		922
901	my $child = $self->child;	923	my $child = $self->child;
902		924
903	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};	925	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
904	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};	926	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
905		927
906	$self->child->configure (0, 0, $w, $h);	928	$self->child->configure (0, 0, $w, $h);
907	$self->update;	929	$self->update;
		930
		931	1
908	}	932	}
909		933
910	sub set_offset {	934	sub set_offset {
911	my ($self, $x, $y) = @_;	935	my ($self, $x, $y) = @_;
912		936
		937	my $x = max 0, min $self->child->{w} - $self->{w}, int $x;
		938	my $y = max 0, min $self->child->{h} - $self->{h}, int $y;
		939
		940	if ($x != $self->{view_x} or $y != $self->{view_y}) {
913	$self->{view_x} = int $x;	941	$self->{view_x} = $x;
914	$self->{view_y} = int $y;	942	$self->{view_y} = $y;
915		943
		944	$self->emit (changed => $x, $y);
916	$self->update;	945	$self->update;
		946	}
		947	}
		948
		949	sub set_center {
		950	my ($self, $x, $y) = @_;
		951
		952	$self->set_offset ($x - $self->{w} * .5, $y - $self->{h} * .5);
		953	}
		954
		955	sub make_visible {
		956	my ($self, $x, $y, $border) = @_;
		957
		958	if ( $x < $self->{view_x} + $self->{w} * $border
		959	|| $x > $self->{view_x} + $self->{w} * (1 - $border)
		960	|| $y < $self->{view_y} + $self->{h} * $border
		961	|| $y > $self->{view_y} + $self->{h} * (1 - $border)
		962	) {
		963	$self->set_center ($x, $y);
		964	}
917	}	965	}
918		966
919	# hmm, this does not work for topleft of $self... but we should not ask for that	967	# hmm, this does not work for topleft of $self... but we should not ask for that
920	sub coord2local {	968	sub coord2local {
921	my ($self, $x, $y) = @_;	969	my ($self, $x, $y) = @_;
…		…
936	my ($self, $x, $y) = @_;	984	my ($self, $x, $y) = @_;
937		985
938	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}	986	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
939	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}	987	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
940	) {	988	) {
941	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})	989	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
942	} else {	990	} else {
943	$self->CFClient::UI::Base::find_widget ($x, $y)	991	$self->CFPlus::UI::Base::find_widget ($x, $y)
944	}	992	}
945	}	993	}
946		994
947	sub _render {	995	sub _render {
948	my ($self) = @_;	996	my ($self) = @_;
949		997
950	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};	998	local $CFPlus::UI::Base::draw_x = $CFPlus::UI::Base::draw_x - $self->{view_x};
951	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};	999	local $CFPlus::UI::Base::draw_y = $CFPlus::UI::Base::draw_y - $self->{view_y};
952		1000
953	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	1001	CFPlus::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
954		1002
955	$self->SUPER::_render;	1003	$self->SUPER::_render;
956	}	1004	}
957		1005
958	#############################################################################	1006	#############################################################################
959		1007
960	package CFClient::UI::ScrolledWindow;	1008	package CFPlus::UI::ScrolledWindow;
961		1009
962	our @ISA = CFClient::UI::HBox::;	1010	our @ISA = CFPlus::UI::Table::;
963		1011
964	sub new {	1012	sub new {
965	my ($class, %arg) = @_;	1013	my ($class, %arg) = @_;
966		1014
967	my $child = delete $arg{child};	1015	my $child = delete $arg{child};
968		1016
969	my $self;	1017	my $self;
970		1018
971	my $slider = new CFClient::UI::Slider	1019	my $hslider = new CFPlus::UI::Slider
		1020	c_col => 0,
		1021	c_row => 1,
		1022	vertical => 0,
		1023	range => [0, 0, 1, 0.01], # HACK fix
		1024	on_changed => sub {
		1025	$self->{hpos} = $_[1];
		1026	$self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
		1027	},
		1028	;
		1029
		1030	my $vslider = new CFPlus::UI::Slider
		1031	c_col => 1,
		1032	c_row => 0,
972	vertical => 1,	1033	vertical => 1,
973	range => [0, 0, 1, 0.01], # HACK fix	1034	range => [0, 0, 1, 0.01], # HACK fix
974	on_changed => sub {	1035	on_changed => sub {
975	$self->{vp}->set_offset (0, $_[1]);	1036	$self->{vpos} = $_[1];
		1037	$self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
976	},	1038	},
977	;	1039	;
978		1040
979	$self = $class->SUPER::new (	1041	$self = $class->SUPER::new (
980	vp => (new CFClient::UI::ViewPort expand => 1),	1042	scroll_x => 0,
		1043	scroll_y => 1,
		1044	can_events => 1,
981	slider => $slider,	1045	hslider => $hslider,
		1046	vslider => $vslider,
		1047	col_expand => [1, 0],
		1048	row_expand => [1, 0],
982	%arg,	1049	%arg,
983	);	1050	);
984		1051
		1052	$self->{vp} = new CFPlus::UI::ViewPort
		1053	c_col => 0,
		1054	c_row => 0,
		1055	expand => 1,
		1056	scroll_x => $self->{scroll_x},
		1057	scroll_y => $self->{scroll_y},
		1058	on_changed => sub {
		1059	my ($vp, $x, $y) = @_;
		1060
		1061	$vp->{parent}{hslider}->set_value ($x);
		1062	$vp->{parent}{vslider}->set_value ($y);
		1063
		1064	0
		1065	},
		1066	on_size_allocate => sub {
		1067	my ($vp, $w, $h) = @_;
		1068	$vp->{parent}->update_slider;
		1069	0
		1070	},
		1071	;
		1072
985	$self->SUPER::add ($self->{vp}, $self->{slider});	1073	$self->SUPER::add ($self->{vp});
		1074
986	$self->add ($child) if $child;	1075	$self->add ($child) if $child;
987		1076
988	$self	1077	$self
989	}	1078	}
990		1079
…		…
992	my ($self, $widget) = @_;	1081	my ($self, $widget) = @_;
993		1082
994	$self->{vp}->add ($self->{child} = $widget);	1083	$self->{vp}->add ($self->{child} = $widget);
995	}	1084	}
996		1085
		1086	sub set_offset { shift->{vp}->set_offset (@_) }
		1087	sub set_center { shift->{vp}->set_center (@_) }
		1088	sub make_visible { shift->{vp}->make_visible (@_) }
		1089
997	sub update {	1090	sub update_slider {
		1091	my ($self) = @_;
		1092
		1093	my $child = ($self->{vp} or return)->child;
		1094
		1095	if ($self->{scroll_x}) {
		1096	my ($w1, $w2) = ($child->{req_w}, $self->{vp}{w});
		1097	$self->{hslider}->set_range ([$self->{hslider}{range}[0], 0, $w1, $w2, 1]);
		1098
		1099	my $visible = $w1 > $w2;
		1100	if ($visible != $self->{hslider_visible}) {
		1101	$self->{hslider_visible} = $visible;
		1102	$visible ? $self->SUPER::add ($self->{hslider})
		1103	: $self->SUPER::remove ($self->{hslider});
		1104	}
		1105	}
		1106
		1107	if ($self->{scroll_y}) {
		1108	my ($h1, $h2) = ($child->{req_h}, $self->{vp}{h});
		1109	$self->{vslider}->set_range ([$self->{vslider}{range}[0], 0, $h1, $h2, 1]);
		1110
		1111	my $visible = $h1 > $h2;
		1112	if ($visible != $self->{vslider_visible}) {
		1113	$self->{vslider_visible} = $visible;
		1114	$visible ? $self->SUPER::add ($self->{vslider})
		1115	: $self->SUPER::remove ($self->{vslider});
		1116	}
		1117	}
		1118	}
		1119
		1120	sub start_dragging {
998	my ($self) = @_;	1121	my ($self, $ev) = @_;
999		1122
1000	$self->SUPER::update;	1123	$self->grab_focus;
1001		1124
1002	# todo: overwrite size_allocate of child	1125	my $ox = $self->{vp}{view_x};
1003	my $child = $self->{vp}->child;	1126	my $oy = $self->{vp}{view_y};
1004	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1127
1005	}	1128	$self->{motion} = sub {
		1129	my ($ev, $x, $y) = @_;
1006		1130
		1131	$ox -= $ev->{xrel};
		1132	$oy -= $ev->{yrel};
		1133
		1134	$self->{vp}->set_offset ($ox, $oy);
		1135	};
		1136	}
		1137
		1138	sub invoke_mouse_wheel {
		1139	my ($self, $ev) = @_;
		1140
		1141	$self->{vslider}->emit (mouse_wheel => $ev) if $self->{vslider_visible};
		1142	$self->{hslider}->emit (mouse_wheel => $ev) if $self->{hslider_visible};
		1143
		1144	1
		1145	}
		1146
		1147	sub invoke_button_down {
		1148	my ($self, $ev, $x, $y) = @_;
		1149
		1150	if ($ev->{button} == 2) {
		1151	$self->start_dragging ($ev);
		1152	return 1;
		1153	}
		1154
		1155	0
		1156	}
		1157
		1158	sub invoke_button_up {
		1159	my ($self, $ev, $x, $y) = @_;
		1160
		1161	if (delete $self->{motion}) {
		1162	return 1;
		1163	}
		1164
		1165	0
		1166	}
		1167
		1168	sub invoke_mouse_motion {
		1169	my ($self, $ev, $x, $y) = @_;
		1170
		1171	if ($self->{motion}) {
		1172	$self->{motion}->($ev, $x, $y);
		1173	return 1;
		1174	}
		1175
		1176	0
		1177	}
		1178
1007	sub size_allocate {	1179	sub invoke_size_allocate {
1008	my ($self, $w, $h) = @_;	1180	my ($self, $w, $h) = @_;
1009		1181
		1182	$self->update_slider;
1010	$self->SUPER::size_allocate ($w, $h);	1183	$self->SUPER::invoke_size_allocate ($w, $h)
1011
1012	my $child = $self->{vp}->child;
1013	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1014	}	1184	}
1015
1016	#TODO# update range on size_allocate depending on child
1017	# update viewport offset on scroll
1018		1185
1019	#############################################################################	1186	#############################################################################
1020		1187
1021	package CFClient::UI::Frame;	1188	package CFPlus::UI::Frame;
1022		1189
1023	our @ISA = CFClient::UI::Bin::;	1190	our @ISA = CFPlus::UI::Bin::;
1024		1191
1025	use CFClient::OpenGL;	1192	use CFPlus::OpenGL;
1026		1193
1027	sub new {	1194	sub new {
1028	my $class = shift;	1195	my $class = shift;
1029		1196
1030	$class->SUPER::new (	1197	$class->SUPER::new (
…		…
1040	my ($w, $h) = @$self{qw(w h)};	1207	my ($w, $h) = @$self{qw(w h)};
1041		1208
1042	glEnable GL_BLEND;	1209	glEnable GL_BLEND;
1043	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	1210	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1044	glColor_premultiply @{ $self->{bg} };	1211	glColor_premultiply @{ $self->{bg} };
1045
1046	glBegin GL_QUADS;
1047	glVertex 0 , 0;
1048	glVertex 0 , $h;
1049	glVertex $w, $h;	1212	glRect 0, 0, $w, $h;
1050	glVertex $w, 0;
1051	glEnd;
1052
1053	glDisable GL_BLEND;	1213	glDisable GL_BLEND;
1054	}	1214	}
1055		1215
1056	$self->SUPER::_draw;	1216	$self->SUPER::_draw;
1057	}	1217	}
1058		1218
1059	#############################################################################	1219	#############################################################################
1060		1220
1061	package CFClient::UI::FancyFrame;	1221	package CFPlus::UI::FancyFrame;
1062		1222
1063	our @ISA = CFClient::UI::Bin::;	1223	our @ISA = CFPlus::UI::Bin::;
1064		1224
1065	use CFClient::OpenGL;	1225	use CFPlus::OpenGL;
		1226
		1227	sub new {
		1228	my ($class, %arg) = @_;
		1229
		1230	if ((exists $arg{label}) && !ref $arg{label}) {
		1231	$arg{label} = new CFPlus::UI::Label
		1232	align => 1,
		1233	valign => 0,
		1234	text => $arg{label},
		1235	fontsize => ($arg{border} || 0.8) * 0.75;
		1236	}
		1237
		1238	my $self = $class->SUPER::new (
		1239	# label => "",
		1240	fg => [0.6, 0.3, 0.1],
		1241	border => 0.8,
		1242	style => 'single',
		1243	%arg,
		1244	);
		1245
		1246	$self
		1247	}
		1248
		1249	sub add {
		1250	my ($self, @widgets) = @_;
		1251
		1252	$self->SUPER::add (@widgets);
		1253	$self->CFPlus::UI::Container::add ($self->{label}) if $self->{label};
		1254	}
		1255
		1256	sub border {
		1257	int $_[0]{border} * $::FONTSIZE
		1258	}
		1259
		1260	sub size_request {
		1261	my ($self) = @_;
		1262
		1263	($self->{label_w}, undef) = $self->{label}->size_request
		1264	if $self->{label};
		1265
		1266	my ($w, $h) = $self->SUPER::size_request;
		1267
		1268	(
		1269	$w + $self->border * 2,
		1270	$h + $self->border * 2,
		1271	)
		1272	}
		1273
		1274	sub invoke_size_allocate {
		1275	my ($self, $w, $h) = @_;
		1276
		1277	my $border = $self->border;
		1278
		1279	$w -= List::Util::max 0, $border * 2;
		1280	$h -= List::Util::max 0, $border * 2;
		1281
		1282	if (my $label = $self->{label}) {
		1283	$label->{w} = List::Util::max 0, List::Util::min $self->{label_w}, $w - $border * 2;
		1284	$label->{h} = List::Util::min $h, $border;
		1285	$label->invoke_size_allocate ($label->{w}, $label->{h});
		1286	}
		1287
		1288	$self->child->configure ($border, $border, $w, $h);
		1289
		1290	1
		1291	}
		1292
		1293	sub _draw {
		1294	my ($self) = @_;
		1295
		1296	my $child = $self->{children}[0];
		1297
		1298	my $border = $self->border;
		1299	my ($w, $h) = ($self->{w}, $self->{h});
		1300
		1301	$child->draw;
		1302
		1303	glColor @{$self->{fg}};
		1304	glBegin GL_LINE_STRIP;
		1305	glVertex $border * 1.5 , $border * 0.5 + 0.5;
		1306	glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5;
		1307	glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
		1308	glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
		1309	glVertex $w - $border * 0.5 + 0.5, $border * 0.5 + 0.5;
		1310	glVertex $self->{label} ? $border * 2 + $self->{label}{w} : $border * 1.5, $border * 0.5 + 0.5;
		1311	glEnd;
		1312
		1313	if ($self->{label}) {
		1314	glTranslate $border * 2, 0;
		1315	$self->{label}->_draw;
		1316	}
		1317	}
		1318
		1319	#############################################################################
		1320
		1321	package CFPlus::UI::Toplevel;
		1322
		1323	our @ISA = CFPlus::UI::Bin::;
		1324
		1325	use CFPlus::OpenGL;
1066		1326
1067	my $bg =	1327	my $bg =
1068	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",	1328	new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png",
1069	mipmap => 1, wrap => 1;	1329	mipmap => 1, wrap => 1;
1070		1330
1071	my @border =	1331	my @border =
1072	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1332	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1073	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1333	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
		1334
		1335	my @icon =
		1336	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
		1337	qw(x1_move.png x1_resize.png);
1074		1338
1075	sub new {	1339	sub new {
1076	my ($class, %arg) = @_;	1340	my ($class, %arg) = @_;
1077		1341
1078	my $self = $class->SUPER::new (	1342	my $self = $class->SUPER::new (
1079	bg => [1, 1, 1, 1],	1343	bg => [1, 1, 1, 1],
1080	border_bg => [1, 1, 1, 1],	1344	border_bg => [1, 1, 1, 1],
1081	border => 0.6,	1345	border => 0.6,
1082	can_events => 1,	1346	can_events => 1,
1083	min_w => 16,	1347	min_w => 64,
1084	min_h => 16,	1348	min_h => 32,
1085	%arg,	1349	%arg,
1086	);	1350	);
1087		1351
1088	$self->{title_widget} = new CFClient::UI::Label	1352	$self->{title_widget} = new CFPlus::UI::Label
1089	align => 0,	1353	align => 0,
1090	valign => 1,	1354	valign => 1,
1091	text => $self->{title},	1355	text => $self->{title},
1092	fontsize => $self->{border},	1356	fontsize => $self->{border},
1093	if exists $self->{title};	1357	if exists $self->{title};
1094		1358
		1359	if ($self->{has_close_button}) {
		1360	$self->{close_button} =
		1361	new CFPlus::UI::ImageButton
		1362	path => 'x1_close.png',
		1363	on_activate => sub { $self->emit ("delete") };
		1364
		1365	$self->CFPlus::UI::Container::add ($self->{close_button});
		1366	}
		1367
1095	$self	1368	$self
1096	}	1369	}
1097		1370
1098	sub add {	1371	sub add {
1099	my ($self, @widgets) = @_;	1372	my ($self, @widgets) = @_;
1100		1373
1101	$self->SUPER::add (@widgets);	1374	$self->SUPER::add (@widgets);
		1375	$self->CFPlus::UI::Container::add ($self->{close_button}) if $self->{close_button};
1102	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};	1376	$self->CFPlus::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1103	}	1377	}
1104		1378
1105	sub border {	1379	sub border {
1106	int $_[0]{border} * $::FONTSIZE	1380	int $_[0]{border} * $::FONTSIZE
1107	}	1381	}
…		…
1109	sub size_request {	1383	sub size_request {
1110	my ($self) = @_;	1384	my ($self) = @_;
1111		1385
1112	$self->{title_widget}->size_request	1386	$self->{title_widget}->size_request
1113	if $self->{title_widget};	1387	if $self->{title_widget};
		1388
		1389	$self->{close_button}->size_request
		1390	if $self->{close_button};
1114		1391
1115	my ($w, $h) = $self->SUPER::size_request;	1392	my ($w, $h) = $self->SUPER::size_request;
1116		1393
1117	(	1394	(
1118	$w + $self->border * 2,	1395	$w + $self->border * 2,
1119	$h + $self->border * 2,	1396	$h + $self->border * 2,
1120	)	1397	)
1121	}	1398	}
1122		1399
1123	sub size_allocate {	1400	sub invoke_size_allocate {
1124	my ($self, $w, $h) = @_;	1401	my ($self, $w, $h) = @_;
1125		1402
1126	if ($self->{title_widget}) {	1403	if ($self->{title_widget}) {
1127	$self->{title_widget}{w} = $w;	1404	$self->{title_widget}{w} = $w;
1128	$self->{title_widget}{h} = $h;	1405	$self->{title_widget}{h} = $h;
1129	$self->{title_widget}->size_allocate ($w, $h);	1406	$self->{title_widget}->invoke_size_allocate ($w, $h);
1130	}	1407	}
1131		1408
1132	my $border = $self->border;	1409	my $border = $self->border;
1133		1410
1134	$h -= List::Util::max 0, $border * 2;	1411	$h -= List::Util::max 0, $border * 2;
1135	$w -= List::Util::max 0, $border * 2;	1412	$w -= List::Util::max 0, $border * 2;
		1413
		1414	$self->child->configure ($border, $border, $w, $h);
		1415
		1416	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1417	if $self->{close_button};
		1418
		1419	1
		1420	}
		1421
		1422	sub invoke_delete {
		1423	my ($self) = @_;
		1424
		1425	$self->hide;
1136		1426
1137	$self->child->configure ($border, $border, $w, $h);	1427	1
1138	}	1428	}
1139		1429
1140	sub button_down {	1430	sub invoke_button_down {
1141	my ($self, $ev, $x, $y) = @_;	1431	my ($self, $ev, $x, $y) = @_;
1142		1432
1143	my ($w, $h) = @$self{qw(w h)};	1433	my ($w, $h) = @$self{qw(w h)};
1144	my $border = $self->border;	1434	my $border = $self->border;
1145		1435
…		…
1176		1466
1177	($x, $y) = ($ev->{x}, $ev->{y});	1467	($x, $y) = ($ev->{x}, $ev->{y});
1178		1468
1179	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1469	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1180	# HACK: the next line is required to enforce placement	1470	# HACK: the next line is required to enforce placement
1181	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});	1471	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1182	};	1472	};
1183	} else {	1473	} else {
1184	return 0;	1474	return 0;
1185	}	1475	}
1186		1476
1187	1	1477	1
1188	}	1478	}
1189		1479
1190	sub button_up {	1480	sub invoke_button_up {
1191	my ($self, $ev, $x, $y) = @_;	1481	my ($self, $ev, $x, $y) = @_;
1192		1482
1193	!!delete $self->{motion}	1483	! ! delete $self->{motion}
1194	}	1484	}
1195		1485
1196	sub mouse_motion {	1486	sub invoke_mouse_motion {
1197	my ($self, $ev, $x, $y) = @_;	1487	my ($self, $ev, $x, $y) = @_;
1198		1488
1199	$self->{motion}->($ev, $x, $y) if $self->{motion};	1489	$self->{motion}->($ev, $x, $y) if $self->{motion};
1200		1490
1201	!!$self->{motion}	1491	! ! $self->{motion}
		1492	}
		1493
		1494	sub invoke_visibility_change {
		1495	my ($self, $visible) = @_;
		1496
		1497	delete $self->{motion} unless $visible;
		1498
		1499	0
1202	}	1500	}
1203		1501
1204	sub _draw {	1502	sub _draw {
1205	my ($self) = @_;	1503	my ($self) = @_;
1206		1504
…		…
1213	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1511	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1214		1512
1215	my $border = $self->border;	1513	my $border = $self->border;
1216		1514
1217	glColor @{ $self->{border_bg} };	1515	glColor @{ $self->{border_bg} };
1218	$border[0]->draw_quad_alpha (0, 0, $w, $border);	1516	$border[0]->draw_quad_alpha ( 0, 0, $w, $border);
1219	$border[1]->draw_quad_alpha (0, $border, $border, $ch);	1517	$border[1]->draw_quad_alpha ( 0, $border, $border, $ch);
1220	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1518	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1221	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);	1519	$border[3]->draw_quad_alpha ( 0, $h - $border, $w, $border);
		1520
		1521	# move
		1522	my $w2 = ($w - $border) * .5;
		1523	my $h2 = ($h - $border) * .5;
		1524	$icon[0]->draw_quad_alpha ( 0, $h2, $border, $border);
		1525	$icon[0]->draw_quad_alpha ($w - $border, $h2, $border, $border);
		1526	$icon[0]->draw_quad_alpha ($w2 , $h - $border, $border, $border);
		1527
		1528	# resize
		1529	$icon[1]->draw_quad_alpha ( 0, 0, $border, $border);
		1530	$icon[1]->draw_quad_alpha ($w - $border, 0, $border, $border)
		1531	unless $self->{has_close_button};
		1532	$icon[1]->draw_quad_alpha ( 0, $h - $border, $border, $border);
		1533	$icon[1]->draw_quad_alpha ($w - $border, $h - $border, $border, $border);
1222		1534
1223	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1535	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1224	glColor @{ $self->{bg} };	1536	glColor @{ $self->{bg} };
1225		1537
1226	# TODO: repeat texture not scale	1538	# TODO: repeat texture not scale
…		…
1235	$child->draw;	1547	$child->draw;
1236		1548
1237	if ($self->{title_widget}) {	1549	if ($self->{title_widget}) {
1238	glTranslate 0, $border - $self->{h};	1550	glTranslate 0, $border - $self->{h};
1239	$self->{title_widget}->_draw;	1551	$self->{title_widget}->_draw;
		1552
		1553	glTranslate 0, - ($border - $self->{h});
1240	}	1554	}
		1555
		1556	$self->{close_button}->draw
		1557	if $self->{close_button};
1241	}	1558	}
1242		1559
1243	#############################################################################	1560	#############################################################################
1244		1561
1245	package CFClient::UI::Table;	1562	package CFPlus::UI::Table;
1246		1563
1247	our @ISA = CFClient::UI::Base::;	1564	our @ISA = CFPlus::UI::Container::;
1248		1565
1249	use List::Util qw(max sum);	1566	use List::Util qw(max sum);
1250		1567
1251	use CFClient::OpenGL;	1568	use CFPlus::OpenGL;
1252		1569
1253	sub new {	1570	sub new {
1254	my $class = shift;	1571	my $class = shift;
1255		1572
1256	$class->SUPER::new (	1573	$class->SUPER::new (
1257	col_expand => [],	1574	col_expand => [],
		1575	row_expand => [],
1258	@_,	1576	@_,
1259	)	1577	)
1260	}	1578	}
1261		1579
1262	sub children {
1263	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1264	}
1265
1266	sub add {	1580	sub add {
1267	my ($self, $x, $y, $child) = @_;	1581	my ($self, @widgets) = @_;
1268		1582
1269	$child->set_parent ($self);	1583	for my $child (@widgets) {
1270	$self->{children}[$y][$x] = $child;	1584	$child->{c_rowspan} ||= 1;
		1585	$child->{c_colspan} ||= 1;
		1586	}
1271		1587
1272	$self->realloc;	1588	$self->SUPER::add (@widgets);
1273	}	1589	}
1274		1590
1275	sub remove {	1591	sub add_at {
		1592	my $self = shift;
		1593
		1594	my @widgets;
		1595
		1596	while (@_) {
		1597	my ($col, $row, $child) = splice @_, 0, 3, ();
		1598
		1599	$child->{c_row} = $row;
		1600	$child->{c_col} = $col;
		1601
		1602	push @widgets, $child;
		1603	}
		1604
		1605	$self->add (@widgets);
		1606	}
		1607
		1608	sub get_wh {
1276	my ($self, $child) = @_;	1609	my ($self) = @_;
1277		1610
1278	# TODO: not yet implemented	1611	my (@w, @h);
1279	}
1280
1281	# TODO: move to container class maybe? send children a signal on removal?
1282	sub clear {
1283	my ($self) = @_;
1284		1612
1285	my @children = $self->children;	1613	my @children = $self->children;
1286	delete $self->{children};	1614
		1615	# first pass, columns
		1616	for my $widget (sort { $a->{c_colspan} <=> $b->{c_colspan} } @children) {
		1617	my ($c, $w, $cs) = @$widget{qw(c_col req_w c_colspan)};
		1618
		1619	my $sw = sum @w[$c .. $c + $cs - 1];
		1620
		1621	if ($w > $sw) {
		1622	$_ += ($w - $sw) / ($sw ? $sw / $_ : $cs) for @w[$c .. $c + $cs - 1];
		1623	}
1287		1624	}
1288	for (@children) {
1289	delete $_->{parent};
1290	$_->hide;
1291	}
1292		1625
1293	$self->realloc;	1626	# second pass, rows
1294	}	1627	for my $widget (sort { $a->{c_rowspan} <=> $b->{c_rowspan} } @children) {
1295
1296	sub get_wh {
1297	my ($self) = @_;
1298
1299	my (@w, @h);
1300
1301	for my $y (0 .. $#{$self->{children}}) {
1302	my $row = $self->{children}[$y]
1303	or next;
1304
1305	for my $x (0 .. $#$row) {
1306	my $widget = $row->[$x]
1307	or next;
1308	my ($w, $h) = @$widget{qw(req_w req_h)};	1628	my ($r, $h, $rs) = @$widget{qw(c_row req_h c_rowspan)};
1309		1629
1310	$w[$x] = max $w[$x], $w;	1630	my $sh = sum @h[$r .. $r + $rs - 1];
1311	$h[$y] = max $h[$y], $h;	1631
		1632	if ($h > $sh) {
		1633	$_ += ($h - $sh) / ($sh ? $sh / $_ : $rs) for @h[$r .. $r + $rs - 1];
1312	}	1634	}
1313	}	1635	}
1314		1636
1315	(\@w, \@h)	1637	(\@w, \@h)
1316	}	1638	}
…		…
1324	(sum @$ws),	1646	(sum @$ws),
1325	(sum @$hs),	1647	(sum @$hs),
1326	)	1648	)
1327	}	1649	}
1328		1650
1329	sub size_allocate {	1651	sub invoke_size_allocate {
1330	my ($self, $w, $h) = @_;	1652	my ($self, $w, $h) = @_;
1331		1653
1332	my ($ws, $hs) = $self->get_wh;	1654	my ($ws, $hs) = $self->get_wh;
1333		1655
1334	my $req_w = (sum @$ws) || 1;	1656	my $req_w = (sum @$ws) || 1;
1335	my $req_h = (sum @$hs) || 1;	1657	my $req_h = (sum @$hs) || 1;
1336		1658
1337	# TODO: nicer code && do row_expand	1659	# now linearly scale the rows/columns to the allocated size
1338	my @col_expand = @{$self->{col_expand}};	1660	my @col_expand = @{$self->{col_expand}};
1339	@col_expand = (1) x @$ws unless @col_expand;	1661	@col_expand = (1) x @$ws unless @col_expand;
1340	my $col_expand = (sum @col_expand) || 1;	1662	my $col_expand = (sum @col_expand) || 1;
1341		1663
1342	# linearly scale sizes
1343	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;	1664	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1344	$hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1345		1665
1346	CFClient::UI::harmonize $ws;	1666	CFPlus::UI::harmonize $ws;
		1667
		1668	my @row_expand = @{$self->{row_expand}};
		1669	@row_expand = (1) x @$ws unless @row_expand;
		1670	my $row_expand = (sum @row_expand) || 1;
		1671
		1672	$hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs;
		1673
1347	CFClient::UI::harmonize $hs;	1674	CFPlus::UI::harmonize $hs;
1348		1675
1349	my $y;	1676	my @x; for (0 .. $#$ws) { $x[$_ + 1] = $x[$_] + $ws->[$_] }
		1677	my @y; for (0 .. $#$hs) { $y[$_ + 1] = $y[$_] + $hs->[$_] }
1350		1678
1351	for my $r (0 .. $#{$self->{children}}) {	1679	for my $widget ($self->children) {
1352	my $row = $self->{children}[$r]	1680	my ($r, $c, $w, $h, $rs, $cs) = @$widget{qw(c_row c_col req_w req_h c_rowspan c_colspan)};
1353	or next;
1354		1681
1355	my $x = 0;	1682	$widget->configure (
1356	my $row_h = $hs->[$r];	1683	$x[$c], $y[$r],
		1684	$x[$c + $cs] - $x[$c], $y[$r + $rs] - $y[$r],
1357		1685	);
1358	for my $c (0 .. $#$row) {	1686	}
1359	my $col_w = $ws->[$c];
1360		1687
1361	if (my $widget = $row->[$c]) {	1688	1
1362	$widget->configure ($x, $y, $col_w, $row_h);	1689	}
1363	}
1364		1690
1365	$x += $col_w;	1691	#############################################################################
		1692
		1693	package CFPlus::UI::Fixed;
		1694
		1695	use List::Util qw(min max);
		1696
		1697	our @ISA = CFPlus::UI::Container::;
		1698
		1699	sub _scale($$$) {
		1700	my ($rel, $val, $max) = @_;
		1701
		1702	$rel ? $val * $max : $val
		1703	}
		1704
		1705	sub size_request {
		1706	my ($self) = @_;
		1707
		1708	my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0);
		1709
		1710	# determine overall size by querying abs widgets
		1711	for my $child ($self->visible_children) {
		1712	unless ($child->{c_rel}) {
		1713	my $x = $child->{c_x};
		1714	my $y = $child->{c_y};
		1715
		1716	$x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
		1717	$y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
1366	}	1718	}
1367
1368	$y += $row_h;
1369	}	1719	}
1370		1720
1371	}	1721	my $W = $x2 - $x1;
		1722	my $H = $y2 - $y1;
1372		1723
1373	sub find_widget {	1724	# now layout remaining widgets
		1725	for my $child ($self->visible_children) {
		1726	if ($child->{c_rel}) {
		1727	my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
		1728	my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
		1729
		1730	$x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
		1731	$y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
		1732	}
		1733	}
		1734
		1735	my $W = $x2 - $x1;
		1736	my $H = $y2 - $y1;
		1737
		1738	($W, $H)
		1739	}
		1740
		1741	sub invoke_size_allocate {
1374	my ($self, $x, $y) = @_;	1742	my ($self, $W, $H) = @_;
1375		1743
1376	$x -= $self->{x};	1744	for my $child ($self->visible_children) {
1377	$y -= $self->{y};	1745	my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
		1746	my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
1378		1747
1379	my $res;	1748	$x += $child->{c_halign} * $child->{req_w};
		1749	$y += $child->{c_valign} * $child->{req_h};
1380		1750
1381	for (grep $_, map @$_, grep $_, @{ $self->{children} }) {	1751	$child->configure (int $x, int $y, $child->{req_w}, $child->{req_h});
1382	$res = $_->find_widget ($x, $y)	1752	}
1383	and return $res;	1753
1384	}	1754	1
1385
1386	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
1387	}
1388
1389	sub _draw {
1390	my ($self) = @_;
1391
1392	for (grep $_, @{$self->{children}}) {
1393	$_->draw for grep $_, @$_;
1394	}
1395	}	1755	}
1396		1756
1397	#############################################################################	1757	#############################################################################
1398		1758
1399	package CFClient::UI::Box;	1759	package CFPlus::UI::Box;
1400		1760
1401	our @ISA = CFClient::UI::Container::;	1761	our @ISA = CFPlus::UI::Container::;
1402		1762
1403	sub size_request {	1763	sub size_request {
1404	my ($self) = @_;	1764	my ($self) = @_;
		1765
		1766	my @children = $self->visible_children;
1405		1767
1406	$self->{vertical}	1768	$self->{vertical}
1407	? (	1769	? (
1408	(List::Util::max map $_->{req_w}, @{$self->{children}}),	1770	(List::Util::max map $_->{req_w}, @children),
1409	(List::Util::sum map $_->{req_h}, @{$self->{children}}),	1771	(List::Util::sum map $_->{req_h}, @children),
1410	)	1772	)
1411	: (	1773	: (
1412	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1774	(List::Util::sum map $_->{req_w}, @children),
1413	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1775	(List::Util::max map $_->{req_h}, @children),
1414	)	1776	)
1415	}	1777	}
1416		1778
1417	sub size_allocate {	1779	sub invoke_size_allocate {
1418	my ($self, $w, $h) = @_;	1780	my ($self, $w, $h) = @_;
1419		1781
1420	my $space = $self->{vertical} ? $h : $w;	1782	my $space = $self->{vertical} ? $h : $w;
1421	my $children = $self->{children};	1783	my @children = $self->visible_children;
1422		1784
1423	my @req;	1785	my @req;
1424		1786
1425	if ($self->{homogeneous}) {	1787	if ($self->{homogeneous}) {
1426	@req = ($space / (@$children || 1)) x @$children;	1788	@req = ($space / (@children || 1)) x @children;
1427	} else {	1789	} else {
1428	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1790	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1429	my $req = List::Util::sum @req;	1791	my $req = List::Util::sum @req;
1430		1792
1431	if ($req > $space) {	1793	if ($req > $space) {
1432	# ah well, not enough space	1794	# ah well, not enough space
1433	$_ *= $space / $req for @req;	1795	$_ *= $space / $req for @req;
1434	} else {	1796	} else {
1435	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1797	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1436		1798
1437	$space = ($space - $req) / $expand; # remaining space to give away	1799	$space = ($space - $req) / $expand; # remaining space to give away
1438		1800
1439	$req[$_] += $space * $children->[$_]{expand}	1801	$req[$_] += $space * $children[$_]{expand}
1440	for 0 .. $#$children;	1802	for 0 .. $#children;
1441	}	1803	}
1442	}	1804	}
1443		1805
1444	CFClient::UI::harmonize \@req;	1806	CFPlus::UI::harmonize \@req;
1445		1807
1446	my $pos = 0;	1808	my $pos = 0;
1447	for (0 .. $#$children) {	1809	for (0 .. $#children) {
1448	my $alloc = $req[$_];	1810	my $alloc = $req[$_];
1449	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1811	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1450		1812
1451	$pos += $alloc;	1813	$pos += $alloc;
1452	}	1814	}
1453		1815
1454	1	1816	1
1455	}	1817	}
1456		1818
1457	#############################################################################	1819	#############################################################################
1458		1820
1459	package CFClient::UI::HBox;	1821	package CFPlus::UI::HBox;
1460		1822
1461	our @ISA = CFClient::UI::Box::;	1823	our @ISA = CFPlus::UI::Box::;
1462		1824
1463	sub new {	1825	sub new {
1464	my $class = shift;	1826	my $class = shift;
1465		1827
1466	$class->SUPER::new (	1828	$class->SUPER::new (
…		…
1469	)	1831	)
1470	}	1832	}
1471		1833
1472	#############################################################################	1834	#############################################################################
1473		1835
1474	package CFClient::UI::VBox;	1836	package CFPlus::UI::VBox;
1475		1837
1476	our @ISA = CFClient::UI::Box::;	1838	our @ISA = CFPlus::UI::Box::;
1477		1839
1478	sub new {	1840	sub new {
1479	my $class = shift;	1841	my $class = shift;
1480		1842
1481	$class->SUPER::new (	1843	$class->SUPER::new (
…		…
1484	)	1846	)
1485	}	1847	}
1486		1848
1487	#############################################################################	1849	#############################################################################
1488		1850
1489	package CFClient::UI::Label;	1851	package CFPlus::UI::Label;
1490		1852
1491	our @ISA = CFClient::UI::DrawBG::;	1853	our @ISA = CFPlus::UI::DrawBG::;
1492		1854
1493	use CFClient::OpenGL;	1855	use CFPlus::OpenGL;
1494		1856
1495	sub new {	1857	sub new {
1496	my ($class, %arg) = @_;	1858	my ($class, %arg) = @_;
1497		1859
1498	my $self = $class->SUPER::new (	1860	my $self = $class->SUPER::new (
…		…
1501	#active_bg => none	1863	#active_bg => none
1502	#font => default_font	1864	#font => default_font
1503	#text => initial text	1865	#text => initial text
1504	#markup => initial narkup	1866	#markup => initial narkup
1505	#max_w => maximum pixel width	1867	#max_w => maximum pixel width
		1868	#style => 0, # render flags
1506	ellipsise => 3, # end	1869	ellipsise => 3, # end
1507	layout => (new CFClient::Layout),	1870	layout => (new CFPlus::Layout),
1508	fontsize => 1,	1871	fontsize => 1,
1509	align => -1,	1872	align => -1,
1510	valign => -1,	1873	valign => -1,
1511	padding_x => 2,	1874	padding_x => 2,
1512	padding_y => 2,	1875	padding_y => 2,
1513	can_events => 0,	1876	can_events => 0,
1514	%arg	1877	%arg
1515	);	1878	);
1516		1879
1517	if (exists $self->{template}) {	1880	if (exists $self->{template}) {
1518	my $layout = new CFClient::Layout;	1881	my $layout = new CFPlus::Layout;
1519	$layout->set_text (delete $self->{template});	1882	$layout->set_text (delete $self->{template});
1520	$self->{template} = $layout;	1883	$self->{template} = $layout;
1521	}	1884	}
1522		1885
1523	if (exists $self->{markup}) {	1886	if (exists $self->{markup}) {
…		…
1527	}	1890	}
1528		1891
1529	$self	1892	$self
1530	}	1893	}
1531		1894
1532	sub escape($) {
1533	local $_ = $_[0];
1534
1535	s/&/&amp;/g;
1536	s/>/&gt;/g;
1537	s/</&lt;/g;
1538
1539	$_
1540	}
1541
1542	sub update {	1895	sub update {
1543	my ($self) = @_;	1896	my ($self) = @_;
1544		1897
1545	delete $self->{texture};	1898	delete $self->{texture};
1546	$self->SUPER::update;	1899	$self->SUPER::update;
…		…
1551		1904
1552	delete $self->{ox};	1905	delete $self->{ox};
1553	$self->SUPER::realloc;	1906	$self->SUPER::realloc;
1554	}	1907	}
1555		1908
		1909	sub clear {
		1910	my ($self) = @_;
		1911
		1912	$self->set_text ("");
		1913	}
		1914
1556	sub set_text {	1915	sub set_text {
1557	my ($self, $text) = @_;	1916	my ($self, $text) = @_;
1558		1917
1559	return if $self->{text} eq "T$text";	1918	return if $self->{text} eq "T$text";
1560	$self->{text} = "T$text";	1919	$self->{text} = "T$text";
1561		1920
1562	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1563	$self->{layout}->set_text ($text);	1921	$self->{layout}->set_text ($text);
1564		1922
1565	delete $self->{size_req};	1923	delete $self->{size_req};
1566	$self->realloc;	1924	$self->realloc;
1567	$self->update;	1925	$self->update;
…		…
1573	return if $self->{text} eq "M$markup";	1931	return if $self->{text} eq "M$markup";
1574	$self->{text} = "M$markup";	1932	$self->{text} = "M$markup";
1575		1933
1576	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1934	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1577		1935
1578	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1579	$self->{layout}->set_markup ($markup);	1936	$self->{layout}->set_markup ($markup);
1580		1937
1581	delete $self->{size_req};	1938	delete $self->{size_req};
1582	$self->realloc;	1939	$self->realloc;
1583	$self->update;	1940	$self->update;
…		…
1595		1952
1596	my ($w, $h) = $self->{layout}->size;	1953	my ($w, $h) = $self->{layout}->size;
1597		1954
1598	if (exists $self->{template}) {	1955	if (exists $self->{template}) {
1599	$self->{template}->set_font ($self->{font}) if $self->{font};	1956	$self->{template}->set_font ($self->{font}) if $self->{font};
		1957	$self->{template}->set_width ($self->{max_w} || -1);
1600	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1958	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1601		1959
1602	my ($w2, $h2) = $self->{template}->size;	1960	my ($w2, $h2) = $self->{template}->size;
1603		1961
1604	$w = List::Util::max $w, $w2;	1962	$w = List::Util::max $w, $w2;
…		…
1609	};	1967	};
1610		1968
1611	@{ $self->{size_req} }	1969	@{ $self->{size_req} }
1612	}	1970	}
1613		1971
		1972	sub baseline_shift {
		1973	$_[0]{layout}->descent
		1974	}
		1975
1614	sub size_allocate {	1976	sub invoke_size_allocate {
1615	my ($self, $w, $h) = @_;	1977	my ($self, $w, $h) = @_;
1616		1978
1617	delete $self->{ox};	1979	delete $self->{ox};
1618		1980
1619	delete $self->{texture}	1981	delete $self->{texture}
1620	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};	1982	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1983
		1984	1
1621	}	1985	}
1622		1986
1623	sub set_fontsize {	1987	sub set_fontsize {
1624	my ($self, $fontsize) = @_;	1988	my ($self, $fontsize) = @_;
1625		1989
1626	$self->{fontsize} = $fontsize;	1990	$self->{fontsize} = $fontsize;
		1991	delete $self->{size_req};
1627	delete $self->{texture};	1992	delete $self->{texture};
1628		1993
1629	$self->realloc;	1994	$self->realloc;
1630	}	1995	}
1631		1996
1632	sub reconfigure {	1997	sub reconfigure {
1633	my ($self) = @_;	1998	my ($self) = @_;
1634		1999
1635	delete $self->{size_req};	2000	delete $self->{size_req};
		2001	delete $self->{texture};
1636		2002
1637	$self->SUPER::reconfigure;	2003	$self->SUPER::reconfigure;
1638	}	2004	}
1639		2005
1640	sub _draw {	2006	sub _draw {
1641	my ($self) = @_;	2007	my ($self) = @_;
1642		2008
1643	$self->SUPER::_draw; # draw background, if applicable	2009	$self->SUPER::_draw; # draw background, if applicable
1644		2010
1645	my $tex = $self->{texture} ||= do {	2011	my $size = $self->{texture} ||= do {
1646	$self->{layout}->set_foreground (@{$self->{fg}});	2012	$self->{layout}->set_foreground (@{$self->{fg}});
1647	$self->{layout}->set_font ($self->{font}) if $self->{font};	2013	$self->{layout}->set_font ($self->{font}) if $self->{font};
1648	$self->{layout}->set_width ($self->{w});	2014	$self->{layout}->set_width ($self->{w});
1649	$self->{layout}->set_ellipsise ($self->{ellipsise});	2015	$self->{layout}->set_ellipsise ($self->{ellipsise});
1650	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	2016	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1651	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2017	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1652		2018
1653	new_from_layout CFClient::Texture $self->{layout}	2019	[$self->{layout}->size]
1654	};	2020	};
1655		2021
1656	unless (exists $self->{ox}) {	2022	unless (exists $self->{ox}) {
1657	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	2023	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1658	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	2024	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1659	: ($self->{w} - $tex->{w}) * 0.5);	2025	: ($self->{w} - $size->[0]) * 0.5);
1660		2026
1661	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	2027	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1662	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	2028	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1663	: ($self->{h} - $tex->{h}) * 0.5);	2029	: ($self->{h} - $size->[1]) * 0.5);
		2030
		2031	$self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1664	};	2032	};
1665		2033
1666	glEnable GL_TEXTURE_2D;	2034	# unless ($self->{list}) {
1667		2035	# $self->{list} = CFPlus::OpenGL::glGenList;
1668	my $w = List::Util::min $self->{w} + 4, $tex->{w};	2036	# CFPlus::OpenGL::glNewList $self->{list};
1669	my $h = List::Util::min $self->{h} + 2, $tex->{h};	2037	# $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1670		2038	# CFPlus::OpenGL::glEndList;
1671	if ($tex->{format} == GL_ALPHA) {
1672	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1673	glColor @{$self->{fg}};
1674	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1675	} else {
1676	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1677	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1678	}	2039	# }
		2040	#
		2041	# CFPlus::OpenGL::glCallList $self->{list};
1679		2042
1680	glDisable GL_TEXTURE_2D;	2043	$self->{layout}->draw;
1681	}	2044	}
		2045
		2046	#sub destroy {
		2047	# my ($self) = @_;
		2048	#
		2049	# CFPlus::OpenGL::glDeleteList delete $self->{list} if $self->{list};
		2050	#
		2051	# $self->SUPER::destroy;
		2052	#}
1682		2053
1683	#############################################################################	2054	#############################################################################
1684		2055
1685	package CFClient::UI::EntryBase;	2056	package CFPlus::UI::EntryBase;
1686		2057
1687	our @ISA = CFClient::UI::Label::;	2058	our @ISA = CFPlus::UI::Label::;
1688		2059
1689	use CFClient::OpenGL;	2060	use CFPlus::OpenGL;
1690		2061
1691	sub new {	2062	sub new {
1692	my $class = shift;	2063	my $class = shift;
1693		2064
1694	$class->SUPER::new (	2065	$class->SUPER::new (
1695	fg => [1, 1, 1],	2066	fg => [1, 1, 1],
1696	bg => [0, 0, 0, 0.2],	2067	bg => [0, 0, 0, 0.2],
		2068	outline => [0.6, 0.3, 0.1],
1697	active_bg => [1, 1, 1, 0.5],	2069	active_bg => [0, 0, 1, .2],
1698	active_fg => [0, 0, 0],	2070	active_fg => [1, 1, 1],
		2071	active_outline => [1, 1, 0],
1699	can_hover => 1,	2072	can_hover => 1,
1700	can_focus => 1,	2073	can_focus => 1,
1701	valign => 0,	2074	valign => 0,
1702	can_events => 1,	2075	can_events => 1,
		2076	ellipsise => 0,
1703	#text => ...	2077	#text => ...
1704	#hidden => "*",	2078	#hidden => "*",
1705	@_	2079	@_
1706	)	2080	)
1707	}	2081	}
…		…
1718		2092
1719	$text =~ s/./*/g if $self->{hidden};	2093	$text =~ s/./*/g if $self->{hidden};
1720	$self->{layout}->set_text ("$text ");	2094	$self->{layout}->set_text ("$text ");
1721	delete $self->{size_req};	2095	delete $self->{size_req};
1722		2096
1723	$self->_emit (changed => $self->{text});	2097	$self->emit (changed => $self->{text});
1724		2098
1725	$self->realloc;	2099	$self->realloc;
1726	$self->update;	2100	$self->update;
1727	}	2101	}
1728		2102
…		…
1743	my ($w, $h) = $self->SUPER::size_request;	2117	my ($w, $h) = $self->SUPER::size_request;
1744		2118
1745	($w + 1, $h) # add 1 for cursor	2119	($w + 1, $h) # add 1 for cursor
1746	}	2120	}
1747		2121
1748	sub key_down {	2122	sub invoke_key_down {
1749	my ($self, $ev) = @_;	2123	my ($self, $ev) = @_;
1750		2124
1751	my $mod = $ev->{mod};	2125	my $mod = $ev->{mod};
1752	my $sym = $ev->{sym};	2126	my $sym = $ev->{sym};
1753	my $uni = $ev->{unicode};	2127	my $uni = $ev->{unicode};
1754		2128
1755	my $text = $self->get_text;	2129	my $text = $self->get_text;
		2130
		2131	$self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text;
1756		2132
1757	if ($uni == 8) {	2133	if ($uni == 8) {
1758	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	2134	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1759	} elsif ($uni == 127) {	2135	} elsif ($uni == 127) {
1760	substr $text, $self->{cursor}, 1, "";	2136	substr $text, $self->{cursor}, 1, "";
1761	} elsif ($sym == CFClient::SDLK_LEFT) {	2137	} elsif ($sym == CFPlus::SDLK_LEFT) {
1762	--$self->{cursor} if $self->{cursor};	2138	--$self->{cursor} if $self->{cursor};
1763	} elsif ($sym == CFClient::SDLK_RIGHT) {	2139	} elsif ($sym == CFPlus::SDLK_RIGHT) {
1764	++$self->{cursor} if $self->{cursor} < length $self->{text};	2140	++$self->{cursor} if $self->{cursor} < length $self->{text};
1765	} elsif ($sym == CFClient::SDLK_HOME) {	2141	} elsif ($sym == CFPlus::SDLK_HOME) {
		2142	# what a hack
		2143	$self->{cursor} =
		2144	(substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
		2145	? length $1
		2146	: 0;
		2147	} elsif ($sym == CFPlus::SDLK_END) {
		2148	# uh, again
		2149	$self->{cursor} =
		2150	(substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
		2151	? $self->{cursor} + length $1
		2152	: length $self->{text};
		2153	} elsif ($uni == 21) { # ctrl-u
		2154	$text = "";
1766	$self->{cursor} = 0;	2155	$self->{cursor} = 0;
1767	} elsif ($sym == CFClient::SDLK_END) {
1768	$self->{cursor} = length $text;
1769	} elsif ($uni == 27) {	2156	} elsif ($uni == 27) {
1770	$self->_emit ('escape');	2157	$self->emit ('escape');
1771	} elsif ($uni) {	2158	} elsif ($uni == 0x0d) {
		2159	substr $text, $self->{cursor}++, 0, "\012";
		2160	} elsif ($uni >= 0x20) {
1772	substr $text, $self->{cursor}++, 0, chr $uni;	2161	substr $text, $self->{cursor}++, 0, chr $uni;
1773	} else {	2162	} else {
1774	return 0;	2163	return 0;
1775	}	2164	}
1776		2165
1777	$self->_set_text ($text);	2166	$self->_set_text ($text);
1778		2167
1779	$self->realloc;	2168	$self->realloc;
		2169	$self->update;
1780		2170
1781	1	2171	1
1782	}	2172	}
1783		2173
1784	sub focus_in {	2174	sub invoke_focus_in {
1785	my ($self) = @_;	2175	my ($self) = @_;
1786		2176
1787	$self->{last_activity} = $::NOW;	2177	$self->{last_activity} = $::NOW;
1788		2178
1789	$self->SUPER::focus_in;	2179	$self->SUPER::invoke_focus_in
1790	}	2180	}
1791		2181
1792	sub button_down {	2182	sub invoke_button_down {
1793	my ($self, $ev, $x, $y) = @_;	2183	my ($self, $ev, $x, $y) = @_;
1794		2184
1795	$self->SUPER::button_down ($ev, $x, $y);	2185	$self->SUPER::invoke_button_down ($ev, $x, $y);
1796		2186
1797	my $idx = $self->{layout}->xy_to_index ($x, $y);	2187	my $idx = $self->{layout}->xy_to_index ($x, $y);
1798		2188
1799	# byte-index to char-index	2189	# byte-index to char-index
1800	my $text = $self->{text};	2190	my $text = $self->{text};
1801	utf8::encode $text;	2191	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1802	$self->{cursor} = length substr $text, 0, $idx;	2192	$self->{cursor} = length $text;
1803		2193
1804	$self->_set_text ($self->{text});	2194	$self->_set_text ($self->{text});
1805	$self->update;	2195	$self->update;
1806		2196
1807	1	2197	1
1808	}	2198	}
1809		2199
1810	sub mouse_motion {	2200	sub invoke_mouse_motion {
1811	my ($self, $ev, $x, $y) = @_;	2201	my ($self, $ev, $x, $y) = @_;
1812	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	2202	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1813		2203
1814	0	2204	1
1815	}	2205	}
1816		2206
1817	sub _draw {	2207	sub _draw {
1818	my ($self) = @_;	2208	my ($self) = @_;
1819		2209
…		…
1826	glColor_premultiply @{$self->{bg}};	2216	glColor_premultiply @{$self->{bg}};
1827	}	2217	}
1828		2218
1829	glEnable GL_BLEND;	2219	glEnable GL_BLEND;
1830	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2220	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1831	glBegin GL_QUADS;
1832	glVertex 0 , 0;
1833	glVertex 0 , $self->{h};
1834	glVertex $self->{w}, $self->{h};	2221	glRect 0, 0, $self->{w}, $self->{h};
1835	glVertex $self->{w}, 0;
1836	glEnd;
1837	glDisable GL_BLEND;	2222	glDisable GL_BLEND;
1838		2223
1839	$self->SUPER::_draw;	2224	$self->SUPER::_draw;
1840		2225
1841	#TODO: force update every cursor change :(	2226	#TODO: force update every cursor change :(
…		…
1843		2228
1844	unless (exists $self->{cur_h}) {	2229	unless (exists $self->{cur_h}) {
1845	my $text = substr $self->{text}, 0, $self->{cursor};	2230	my $text = substr $self->{text}, 0, $self->{cursor};
1846	utf8::encode $text;	2231	utf8::encode $text;
1847		2232
1848	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)	2233	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
1849	}	2234	}
1850		2235
1851	glColor @{$self->{fg}};	2236	glColor_premultiply @{$self->{active_fg}};
1852	glBegin GL_LINES;	2237	glBegin GL_LINES;
1853	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};	2238	glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy};
1854	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};	2239	glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1855	glEnd;	2240	glEnd;
1856	}
1857	}
1858		2241
		2242	glLineWidth 3;
		2243	glColor @{$self->{active_outline}};
		2244	glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
		2245	glLineWidth 1;
		2246
		2247	} else {
		2248	glColor @{$self->{outline}};
		2249	glBegin GL_LINE_STRIP;
		2250	glVertex .5, $self->{h} * .5;
		2251	glVertex .5, $self->{h} - 2.5;
		2252	glVertex $self->{w} - .5, $self->{h} - 2.5;
		2253	glVertex $self->{w} - .5, $self->{h} * .5;
		2254	glEnd;
		2255	}
		2256	}
		2257
		2258	#############################################################################
		2259
1859	package CFClient::UI::Entry;	2260	package CFPlus::UI::Entry;
1860		2261
1861	our @ISA = CFClient::UI::EntryBase::;	2262	our @ISA = CFPlus::UI::EntryBase::;
1862		2263
1863	use CFClient::OpenGL;	2264	use CFPlus::OpenGL;
1864		2265
1865	sub key_down {	2266	sub invoke_key_down {
1866	my ($self, $ev) = @_;	2267	my ($self, $ev) = @_;
1867		2268
1868	my $sym = $ev->{sym};	2269	my $sym = $ev->{sym};
1869		2270
1870	if ($sym == 13) {	2271	if ($ev->{uni} == 0x0d || $sym == 13) {
1871	unshift @{$self->{history}},	2272	unshift @{$self->{history}},
1872	my $txt = $self->get_text;	2273	my $txt = $self->get_text;
		2274
1873	$self->{history_pointer} = -1;	2275	$self->{history_pointer} = -1;
1874	$self->{history_saveback} = '';	2276	$self->{history_saveback} = '';
1875	$self->_emit (activate => $txt);	2277	$self->emit (activate => $txt);
1876	$self->update;	2278	$self->update;
1877		2279
1878	} elsif ($sym == CFClient::SDLK_UP) {	2280	} elsif ($sym == CFPlus::SDLK_UP) {
1879	if ($self->{history_pointer} < 0) {	2281	if ($self->{history_pointer} < 0) {
1880	$self->{history_saveback} = $self->get_text;	2282	$self->{history_saveback} = $self->get_text;
1881	}	2283	}
1882	if (@{$self->{history} || []} > 0) {	2284	if (@{$self->{history} || []} > 0) {
1883	$self->{history_pointer}++;	2285	$self->{history_pointer}++;
…		…
1885	$self->{history_pointer} = @{$self->{history} || []} - 1;	2287	$self->{history_pointer} = @{$self->{history} || []} - 1;
1886	}	2288	}
1887	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2289	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1888	}	2290	}
1889		2291
1890	} elsif ($sym == CFClient::SDLK_DOWN) {	2292	} elsif ($sym == CFPlus::SDLK_DOWN) {
1891	$self->{history_pointer}--;	2293	$self->{history_pointer}--;
1892	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	2294	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1893		2295
1894	if ($self->{history_pointer} >= 0) {	2296	if ($self->{history_pointer} >= 0) {
1895	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2297	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1896	} else {	2298	} else {
1897	$self->set_text ($self->{history_saveback});	2299	$self->set_text ($self->{history_saveback});
1898	}	2300	}
1899		2301
1900	} else {	2302	} else {
1901	return $self->SUPER::key_down ($ev)	2303	return $self->SUPER::invoke_key_down ($ev)
1902	}	2304	}
1903		2305
1904	1	2306	1
1905	}	2307	}
1906		2308
1907	#############################################################################	2309	#############################################################################
1908		2310
		2311	package CFPlus::UI::TextEdit;
		2312
		2313	our @ISA = CFPlus::UI::EntryBase::;
		2314
		2315	use CFPlus::OpenGL;
		2316
		2317	sub move_cursor_ver {
		2318	my ($self, $dy) = @_;
		2319
		2320	my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
		2321
		2322	$y += $dy;
		2323
		2324	if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) {
		2325	$self->{cursor} = $index;
		2326	delete $self->{cur_h};
		2327	$self->update;
		2328	return;
		2329	}
		2330	}
		2331
		2332	sub invoke_key_down {
		2333	my ($self, $ev) = @_;
		2334
		2335	my $sym = $ev->{sym};
		2336
		2337	if ($sym == CFPlus::SDLK_UP) {
		2338	$self->move_cursor_ver (-1);
		2339	} elsif ($sym == CFPlus::SDLK_DOWN) {
		2340	$self->move_cursor_ver (+1);
		2341	} else {
		2342	return $self->SUPER::invoke_key_down ($ev)
		2343	}
		2344
		2345	1
		2346	}
		2347
		2348	#############################################################################
		2349
1909	package CFClient::UI::Button;	2350	package CFPlus::UI::ButtonBin;
1910		2351
1911	our @ISA = CFClient::UI::Label::;	2352	our @ISA = CFPlus::UI::Bin::;
1912		2353
1913	use CFClient::OpenGL;	2354	use CFPlus::OpenGL;
1914		2355
1915	my @tex =	2356	my @tex =
1916	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2357	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1917	qw(b1_button_active.png);	2358	qw(b1_button_inactive.png b1_button_active.png);
1918		2359
1919	sub new {	2360	sub new {
1920	my $class = shift;	2361	my $class = shift;
1921		2362
1922	$class->SUPER::new (	2363	$class->SUPER::new (
1923	padding_x => 4,
1924	padding_y => 4,
1925	fg => [1, 1, 1],
1926	active_fg => [0, 0, 1],
1927	can_hover => 1,	2364	can_hover => 1,
1928	align => 0,	2365	align => 0,
1929	valign => 0,	2366	valign => 0,
1930	can_events => 1,	2367	can_events => 1,
1931	@_	2368	@_
1932	)	2369	)
1933	}	2370	}
1934		2371
1935	sub activate { }
1936
1937	sub button_up {	2372	sub invoke_button_up {
1938	my ($self, $ev, $x, $y) = @_;	2373	my ($self, $ev, $x, $y) = @_;
1939		2374
1940	$self->emit ("activate")	2375	$self->emit ("activate")
1941	if $x >= 0 && $x < $self->{w}	2376	if $x >= 0 && $x < $self->{w}
1942	&& $y >= 0 && $y < $self->{h};	2377	&& $y >= 0 && $y < $self->{h};
…		…
1945	}	2380	}
1946		2381
1947	sub _draw {	2382	sub _draw {
1948	my ($self) = @_;	2383	my ($self) = @_;
1949		2384
1950	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1951
1952	glEnable GL_TEXTURE_2D;	2385	glEnable GL_TEXTURE_2D;
1953	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2386	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1954	glColor 0, 0, 0, 1;	2387	glColor 0, 0, 0, 1;
1955		2388
		2389	my $tex = $tex[$GRAB == $self];
1956	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2390	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1957		2391
1958	glDisable GL_TEXTURE_2D;	2392	glDisable GL_TEXTURE_2D;
1959		2393
1960	$self->SUPER::_draw;	2394	$self->SUPER::_draw;
1961	}	2395	}
1962		2396
1963	#############################################################################	2397	#############################################################################
1964		2398
1965	package CFClient::UI::CheckBox;	2399	package CFPlus::UI::Button;
1966		2400
1967	our @ISA = CFClient::UI::DrawBG::;	2401	our @ISA = CFPlus::UI::Label::;
		2402
		2403	use CFPlus::OpenGL;
1968		2404
1969	my @tex =	2405	my @tex =
1970	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2406	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
		2407	qw(b1_button_inactive.png b1_button_active.png);
		2408
		2409	sub new {
		2410	my $class = shift;
		2411
		2412	$class->SUPER::new (
		2413	padding_x => 4,
		2414	padding_y => 4,
		2415	fg => [1.0, 1.0, 1.0],
		2416	active_fg => [0.8, 0.8, 0.8],
		2417	can_hover => 1,
		2418	align => 0,
		2419	valign => 0,
		2420	can_events => 1,
		2421	@_
		2422	)
		2423	}
		2424
		2425	sub invoke_button_up {
		2426	my ($self, $ev, $x, $y) = @_;
		2427
		2428	$self->emit ("activate")
		2429	if $x >= 0 && $x < $self->{w}
		2430	&& $y >= 0 && $y < $self->{h};
		2431
		2432	1
		2433	}
		2434
		2435	sub _draw {
		2436	my ($self) = @_;
		2437
		2438	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
		2439
		2440	glEnable GL_TEXTURE_2D;
		2441	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2442	glColor 0, 0, 0, 1;
		2443
		2444	my $tex = $tex[$GRAB == $self];
		2445	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
		2446
		2447	glDisable GL_TEXTURE_2D;
		2448
		2449	$self->SUPER::_draw;
		2450	}
		2451
		2452	#############################################################################
		2453
		2454	package CFPlus::UI::CheckBox;
		2455
		2456	our @ISA = CFPlus::UI::DrawBG::;
		2457
		2458	my @tex =
		2459	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1971	qw(c1_checkbox_bg.png c1_checkbox_active.png);	2460	qw(c1_checkbox_bg.png c1_checkbox_active.png);
1972		2461
1973	use CFClient::OpenGL;	2462	use CFPlus::OpenGL;
1974		2463
1975	sub new {	2464	sub new {
1976	my $class = shift;	2465	my $class = shift;
1977		2466
1978	$class->SUPER::new (	2467	$class->SUPER::new (
…		…
1992	my ($self) = @_;	2481	my ($self) = @_;
1993		2482
1994	(6) x 2	2483	(6) x 2
1995	}	2484	}
1996		2485
		2486	sub toggle {
		2487	my ($self) = @_;
		2488
		2489	$self->{state} = !$self->{state};
		2490	$self->emit (changed => $self->{state});
		2491	$self->update;
		2492	}
		2493
1997	sub button_down {	2494	sub invoke_button_down {
1998	my ($self, $ev, $x, $y) = @_;	2495	my ($self, $ev, $x, $y) = @_;
1999		2496
2000	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2497	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2001	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2498	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2002	$self->{state} = !$self->{state};	2499	$self->toggle;
2003	$self->_emit (changed => $self->{state});
2004	} else {	2500	} else {
2005	return 0	2501	return 0
2006	}	2502	}
2007		2503
2008	1	2504	1
…		…
2011	sub _draw {	2507	sub _draw {
2012	my ($self) = @_;	2508	my ($self) = @_;
2013		2509
2014	$self->SUPER::_draw;	2510	$self->SUPER::_draw;
2015		2511
2016	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;	2512	glTranslate $self->{padding_x}, $self->{padding_y}, 0;
2017		2513
2018	my ($w, $h) = @$self{qw(w h)};	2514	my ($w, $h) = @$self{qw(w h)};
2019		2515
2020	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;	2516	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2021		2517
…		…
2028	glDisable GL_TEXTURE_2D;	2524	glDisable GL_TEXTURE_2D;
2029	}	2525	}
2030		2526
2031	#############################################################################	2527	#############################################################################
2032		2528
2033	package CFClient::UI::Image;	2529	package CFPlus::UI::Image;
2034		2530
2035	our @ISA = CFClient::UI::Base::;	2531	our @ISA = CFPlus::UI::Base::;
2036		2532
2037	use CFClient::OpenGL;	2533	use CFPlus::OpenGL;
2038	use Carp qw/confess/;
2039		2534
2040	our %loaded_images;	2535	our %texture_cache;
2041		2536
2042	sub new {	2537	sub new {
2043	my $class = shift;	2538	my $class = shift;
2044		2539
2045	my $self = $class->SUPER::new (can_events => 0, @_);	2540	my $self = $class->SUPER::new (
		2541	can_events => 0,
		2542	scale => 1,
		2543	@_,
		2544	);
2046		2545
2047	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2546	$self->{path} || $self->{tex}
		2547	or Carp::croak "'path' or 'tex' attributes required";
2048		2548
2049	$loaded_images{$self->{image}} ||=	2549	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2050	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2550	new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
2051		2551
2052	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2552	CFPlus::weaken $texture_cache{$self->{path}};
2053		2553
2054	Scalar::Util::weaken $loaded_images{$self->{image}};	2554	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2055
2056	$self->{aspect} = $tex->{w} / $tex->{h};
2057		2555
2058	$self	2556	$self
2059	}	2557	}
2060		2558
		2559	sub STORABLE_freeze {
		2560	my ($self, $cloning) = @_;
		2561
		2562	$self->{path}
		2563	or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
		2564
		2565	$self->{path}
		2566	}
		2567
		2568	sub STORABLE_attach {
		2569	my ($self, $cloning, $path) = @_;
		2570
		2571	$self->new (path => $path)
		2572	}
		2573
2061	sub size_request {	2574	sub size_request {
2062	my ($self) = @_;	2575	my ($self) = @_;
2063		2576
2064	($self->{tex}->{w}, $self->{tex}->{h})	2577	(int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
2065	}	2578	}
2066		2579
2067	sub _draw {	2580	sub _draw {
2068	my ($self) = @_;	2581	my ($self) = @_;
2069		2582
…		…
2086	glDisable GL_TEXTURE_2D;	2599	glDisable GL_TEXTURE_2D;
2087	}	2600	}
2088		2601
2089	#############################################################################	2602	#############################################################################
2090		2603
		2604	package CFPlus::UI::ImageButton;
		2605
		2606	our @ISA = CFPlus::UI::Image::;
		2607
		2608	use CFPlus::OpenGL;
		2609
		2610	my %textures;
		2611
		2612	sub new {
		2613	my $class = shift;
		2614
		2615	my $self = $class->SUPER::new (
		2616	padding_x => 4,
		2617	padding_y => 4,
		2618	fg => [1, 1, 1],
		2619	active_fg => [0, 0, 1],
		2620	can_hover => 1,
		2621	align => 0,
		2622	valign => 0,
		2623	can_events => 1,
		2624	@_
		2625	);
		2626	}
		2627
		2628	sub invoke_button_down {
		2629	my ($self, $ev, $x, $y) = @_;
		2630
		2631	1
		2632	}
		2633
		2634	sub invoke_button_up {
		2635	my ($self, $ev, $x, $y) = @_;
		2636
		2637	$self->emit ("activate")
		2638	if $x >= 0 && $x < $self->{w}
		2639	&& $y >= 0 && $y < $self->{h};
		2640
		2641	1
		2642	}
		2643
		2644	#############################################################################
		2645
2091	package CFClient::UI::VGauge;	2646	package CFPlus::UI::VGauge;
2092		2647
2093	our @ISA = CFClient::UI::Base::;	2648	our @ISA = CFPlus::UI::Base::;
2094		2649
2095	use List::Util qw(min max);	2650	use List::Util qw(min max);
2096		2651
2097	use CFClient::OpenGL;	2652	use CFPlus::OpenGL;
2098		2653
2099	my %tex = (	2654	my %tex = (
2100	food => [	2655	food => [
2101	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2656	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2102	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2657	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2103	],	2658	],
2104	grace => [	2659	grace => [
2105	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2660	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2106	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/	2661	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2107	],	2662	],
2108	hp => [	2663	hp => [
2109	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2664	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2110	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2665	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2111	],	2666	],
2112	mana => [	2667	mana => [
2113	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2668	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2114	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/	2669	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2115	],	2670	],
2116	);	2671	);
2117		2672
2118	# eg. VGauge->new (gauge => 'food'), default gauge: food	2673	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2178	my $ycut1 = max 0, min 1, $ycut;	2733	my $ycut1 = max 0, min 1, $ycut;
2179	my $ycut2 = max 0, min 1, $ycut - 1;	2734	my $ycut2 = max 0, min 1, $ycut - 1;
2180		2735
2181	my $h1 = $self->{h} * (1 - $ycut1);	2736	my $h1 = $self->{h} * (1 - $ycut1);
2182	my $h2 = $self->{h} * (1 - $ycut2);	2737	my $h2 = $self->{h} * (1 - $ycut2);
		2738	my $h3 = $self->{h};
		2739
		2740	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2183		2741
2184	glEnable GL_BLEND;	2742	glEnable GL_BLEND;
2185	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2743	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2186	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2744	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2187	glEnable GL_TEXTURE_2D;	2745	glEnable GL_TEXTURE_2D;
…		…
2206		2764
2207	if ($t3) {	2765	if ($t3) {
2208	glBindTexture GL_TEXTURE_2D, $t3->{name};	2766	glBindTexture GL_TEXTURE_2D, $t3->{name};
2209	glBegin GL_QUADS;	2767	glBegin GL_QUADS;
2210	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2768	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2211	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2769	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2212	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2770	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2213	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2771	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2214	glEnd;	2772	glEnd;
2215	}	2773	}
2216		2774
2217	glDisable GL_BLEND;	2775	glDisable GL_BLEND;
2218	glDisable GL_TEXTURE_2D;	2776	glDisable GL_TEXTURE_2D;
2219	}	2777	}
2220		2778
2221	#############################################################################	2779	#############################################################################
2222		2780
		2781	package CFPlus::UI::Progress;
		2782
		2783	our @ISA = CFPlus::UI::Label::;
		2784
		2785	use CFPlus::OpenGL;
		2786
		2787	sub new {
		2788	my ($class, %arg) = @_;
		2789
		2790	my $self = $class->SUPER::new (
		2791	fg => [1, 1, 1],
		2792	bg => [0, 0, 1, 0.2],
		2793	bar => [0.7, 0.5, 0.1, 0.8],
		2794	outline => [0.4, 0.3, 0],
		2795	fontsize => 0.9,
		2796	valign => 0,
		2797	align => 0,
		2798	can_events => 1,
		2799	ellipsise => 1,
		2800	label => "%d%%",
		2801	%arg,
		2802	);
		2803
		2804	$self->set_value ($arg{value} || -1);
		2805
		2806	$self
		2807	}
		2808
		2809	sub set_label {
		2810	my ($self, $label) = @_;
		2811
		2812	return if $self->{label} eq $label;
		2813	$self->{label} = $label;
		2814
		2815	$self->CFPlus::UI::Progress::set_value (0 + delete $self->{value});
		2816	}
		2817
		2818	sub set_value {
		2819	my ($self, $value) = @_;
		2820
		2821	if ($self->{value} ne $value) {
		2822	$self->{value} = $value;
		2823
		2824	if ($value < 0) {
		2825	$self->set_text ("-");
		2826	} else {
		2827	$self->set_text (sprintf $self->{label}, $value * 100);
		2828	}
		2829
		2830	$self->update;
		2831	}
		2832	}
		2833
		2834	sub _draw {
		2835	my ($self) = @_;
		2836
		2837	glEnable GL_BLEND;
		2838	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
		2839
		2840	if ($self->{value} >= 0) {
		2841	my $s = int 2 + ($self->{w} - 4) * $self->{value};
		2842
		2843	glColor_premultiply @{$self->{bar}};
		2844	glRect 2, 2, $s, $self->{h} - 2;
		2845	glColor_premultiply @{$self->{bg}};
		2846	glRect $s, 2, $self->{w} - 2, $self->{h} - 2;
		2847	}
		2848
		2849	glColor_premultiply @{$self->{outline}};
		2850	glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
		2851
		2852	glDisable GL_BLEND;
		2853
		2854	{
		2855	local $self->{bg}; # do not draw background
		2856	$self->SUPER::_draw;
		2857	}
		2858	}
		2859
		2860	#############################################################################
		2861
		2862	package CFPlus::UI::ExperienceProgress;
		2863
		2864	our @ISA = CFPlus::UI::Progress::;
		2865
		2866	sub new {
		2867	my ($class, %arg) = @_;
		2868
		2869	my $self = $class->SUPER::new (
		2870	tooltip => sub {
		2871	my ($self) = @_;
		2872
		2873	sprintf "level %d\n%s points\n%s next level\n%s to go",
		2874	$self->{lvl},
		2875	::formsep ($self->{exp}),
		2876	::formsep ($self->{nxt}),
		2877	::formsep ($self->{nxt} - $self->{exp}),
		2878	},
		2879	%arg
		2880	);
		2881
		2882	$::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) }
		2883	if $::CONN;
		2884
		2885	$self
		2886	}
		2887
		2888	sub DESTROY {
		2889	my ($self) = @_;
		2890
		2891	delete $::CONN->{on_exp_update}{$self+0}
		2892	if $::CONN;
		2893
		2894	$self->SUPER::DESTROY;
		2895	}
		2896
		2897	sub set_value {
		2898	my ($self, $lvl, $exp) = @_;
		2899
		2900	$self->{lvl} = $lvl;
		2901	$self->{exp} = $exp;
		2902
		2903	my $v = -1;
		2904
		2905	if ($::CONN && (my $table = $::CONN->{exp_table})) {
		2906	my $l0 = $table->[$lvl - 1];
		2907	my $l1 = $table->[$lvl];
		2908
		2909	$self->{nxt} = $l1;
		2910
		2911	$v = ($exp - $l0) / ($l1 - $l0);
		2912	}
		2913
		2914	$self->SUPER::set_value ($v);
		2915	}
		2916
		2917	#############################################################################
		2918
2223	package CFClient::UI::Gauge;	2919	package CFPlus::UI::Gauge;
2224		2920
2225	our @ISA = CFClient::UI::VBox::;	2921	our @ISA = CFPlus::UI::VBox::;
2226		2922
2227	sub new {	2923	sub new {
2228	my ($class, %arg) = @_;	2924	my ($class, %arg) = @_;
2229		2925
2230	my $self = $class->SUPER::new (	2926	my $self = $class->SUPER::new (
…		…
2232	can_hover => 1,	2928	can_hover => 1,
2233	can_events => 1,	2929	can_events => 1,
2234	%arg,	2930	%arg,
2235	);	2931	);
2236		2932
2237	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2933	$self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999");
2238	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);	2934	$self->add ($self->{gauge} = new CFPlus::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
2239	$self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999");	2935	$self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2240		2936
2241	$self	2937	$self
2242	}	2938	}
2243		2939
2244	sub set_fontsize {	2940	sub set_fontsize {
…		…
2265	$self->{value}->set_text ($val);	2961	$self->{value}->set_text ($val);
2266	}	2962	}
2267		2963
2268	#############################################################################	2964	#############################################################################
2269		2965
2270	package CFClient::UI::Slider;	2966	package CFPlus::UI::Slider;
2271		2967
2272	use strict;	2968	use strict;
2273		2969
2274	use CFClient::OpenGL;	2970	use CFPlus::OpenGL;
2275		2971
2276	our @ISA = CFClient::UI::DrawBG::;	2972	our @ISA = CFPlus::UI::DrawBG::;
2277		2973
2278	my @tex =	2974	my @tex =
2279	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	2975	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2280	qw(s1_slider.png s1_slider_bg.png);	2976	qw(s1_slider.png s1_slider_bg.png);
2281		2977
2282	sub new {	2978	sub new {
2283	my $class = shift;	2979	my $class = shift;
2284		2980
…		…
2305	$self->update;	3001	$self->update;
2306		3002
2307	$self	3003	$self
2308	}	3004	}
2309		3005
2310	sub changed { }
2311
2312	sub set_range {	3006	sub set_range {
2313	my ($self, $range) = @_;	3007	my ($self, $range) = @_;
2314		3008
2315	($range, $self->{range}) = ($self->{range}, $range);	3009	($range, $self->{range}) = ($self->{range}, $range);
2316		3010
…		…
2336	if $unit;	3030	if $unit;
2337		3031
2338	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	3032	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2339		3033
2340	if ($value != $old_value) {	3034	if ($value != $old_value) {
2341	$self->_emit (changed => $value);	3035	$self->emit (changed => $value);
2342	$self->update;	3036	$self->update;
2343	}	3037	}
2344	}	3038	}
2345		3039
2346	sub size_request {	3040	sub size_request {
2347	my ($self) = @_;	3041	my ($self) = @_;
2348		3042
2349	($self->{req_w}, $self->{req_h})	3043	($self->{req_w}, $self->{req_h})
2350	}	3044	}
2351		3045
2352	sub button_down {	3046	sub invoke_button_down {
2353	my ($self, $ev, $x, $y) = @_;	3047	my ($self, $ev, $x, $y) = @_;
2354		3048
2355	$self->SUPER::button_down ($ev, $x, $y);	3049	$self->SUPER::invoke_button_down ($ev, $x, $y);
2356		3050
2357	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	3051	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2358		3052
2359	$self->mouse_motion ($ev, $x, $y)	3053	$self->invoke_mouse_motion ($ev, $x, $y);
2360	}
2361		3054
		3055	1
		3056	}
		3057
2362	sub mouse_motion {	3058	sub invoke_mouse_motion {
2363	my ($self, $ev, $x, $y) = @_;	3059	my ($self, $ev, $x, $y) = @_;
2364		3060
2365	if ($GRAB == $self) {	3061	if ($GRAB == $self) {
2366	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	3062	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2367		3063
…		…
2371		3067
2372	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	3068	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2373	} else {	3069	} else {
2374	return 0;	3070	return 0;
2375	}	3071	}
		3072
		3073	1
		3074	}
		3075
		3076	sub invoke_mouse_wheel {
		3077	my ($self, $ev) = @_;
		3078
		3079	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		3080
		3081	my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2;
		3082
		3083	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
2376		3084
2377	1	3085	1
2378	}	3086	}
2379		3087
2380	sub update {	3088	sub update {
…		…
2431	glDisable GL_TEXTURE_2D;	3139	glDisable GL_TEXTURE_2D;
2432	}	3140	}
2433		3141
2434	#############################################################################	3142	#############################################################################
2435		3143
2436	package CFClient::UI::ValSlider;	3144	package CFPlus::UI::ValSlider;
2437		3145
2438	our @ISA = CFClient::UI::HBox::;	3146	our @ISA = CFPlus::UI::HBox::;
2439		3147
2440	sub new {	3148	sub new {
2441	my ($class, %arg) = @_;	3149	my ($class, %arg) = @_;
2442		3150
2443	my $range = delete $arg{range};	3151	my $range = delete $arg{range};
2444		3152
2445	my $self = $class->SUPER::new (	3153	my $self = $class->SUPER::new (
2446	slider => (new CFClient::UI::Slider expand => 1, range => $range),	3154	slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2447	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	3155	entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2448	to_value => sub { shift },	3156	to_value => sub { shift },
2449	from_value => sub { shift },	3157	from_value => sub { shift },
2450	%arg,	3158	%arg,
2451	);	3159	);
2452		3160
…		…
2472	sub set_range { shift->{slider}->set_range (@_) }	3180	sub set_range { shift->{slider}->set_range (@_) }
2473	sub set_value { shift->{slider}->set_value (@_) }	3181	sub set_value { shift->{slider}->set_value (@_) }
2474		3182
2475	#############################################################################	3183	#############################################################################
2476		3184
2477	package CFClient::UI::TextScroller;	3185	package CFPlus::UI::TextScroller;
2478		3186
2479	our @ISA = CFClient::UI::HBox::;	3187	our @ISA = CFPlus::UI::HBox::;
2480		3188
2481	use CFClient::OpenGL;	3189	use CFPlus::OpenGL;
2482		3190
2483	sub new {	3191	sub new {
2484	my $class = shift;	3192	my $class = shift;
2485		3193
2486	my $self = $class->SUPER::new (	3194	my $self = $class->SUPER::new (
2487	fontsize => 1,	3195	fontsize => 1,
2488	can_events => 0,	3196	can_events => 1,
2489	indent => 0,	3197	indent => 0,
2490	#font => default_font	3198	#font => default_font
2491	@_,	3199	@_,
2492		3200
2493	layout => (new CFClient::Layout 1),	3201	layout => (new CFPlus::Layout),
2494	par => [],	3202	par => [],
		3203	max_par => 0,
2495	height => 0,	3204	height => 0,
2496	children => [	3205	children => [
2497	(new CFClient::UI::Empty expand => 1),	3206	(new CFPlus::UI::Empty expand => 1),
2498	(new CFClient::UI::Slider vertical => 1),	3207	(new CFPlus::UI::Slider vertical => 1),
2499	],	3208	],
2500	);	3209	);
2501		3210
2502	$self->{children}[1]->connect (changed => sub { $self->update });	3211	$self->{children}[1]->connect (changed => sub { $self->update });
2503		3212
…		…
2509		3218
2510	$self->{fontsize} = $fontsize;	3219	$self->{fontsize} = $fontsize;
2511	$self->reflow;	3220	$self->reflow;
2512	}	3221	}
2513		3222
		3223	sub size_request {
		3224	my ($self) = @_;
		3225
		3226	my ($empty, $slider) = $self->visible_children;
		3227
		3228	local $self->{children} = [$empty, $slider];
		3229	$self->SUPER::size_request
		3230	}
		3231
2514	sub size_allocate {	3232	sub invoke_size_allocate {
2515	my ($self, $w, $h) = @_;	3233	my ($self, $w, $h) = @_;
2516		3234
2517	$self->SUPER::size_allocate ($w, $h);	3235	my ($empty, $slider, @other) = @{ $self->{children} };
		3236	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2518		3237
2519	$self->{layout}->set_font ($self->{font}) if $self->{font};	3238	$self->{layout}->set_font ($self->{font}) if $self->{font};
2520	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	3239	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2521	$self->{layout}->set_width ($self->{children}[0]{w});	3240	$self->{layout}->set_width ($empty->{w});
2522	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	3241	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2523		3242
2524	$self->reflow;	3243	$self->reflow;
2525	}
2526		3244
2527	sub text_size {	3245	local $self->{children} = [$empty, $slider];
		3246	$self->SUPER::invoke_size_allocate ($w, $h)
		3247	}
		3248
		3249	sub invoke_mouse_wheel {
2528	my ($self, $text, $indent) = @_;	3250	my ($self, $ev) = @_;
		3251
		3252	return 0 unless $ev->{dy}; # only vertical movements
		3253
		3254	$self->{children}[1]->emit (mouse_wheel => $ev);
		3255
		3256	1
		3257	}
		3258
		3259	sub get_layout {
		3260	my ($self, $para) = @_;
2529		3261
2530	my $layout = $self->{layout};	3262	my $layout = $self->{layout};
2531		3263
		3264	$layout->set_font ($self->{font}) if $self->{font};
		3265	$layout->set_foreground (@{$para->{fg}});
2532	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	3266	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2533	$layout->set_width ($self->{children}[0]{w} - $indent);	3267	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2534	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	3268	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2535	$layout->set_markup ($text);	3269	$layout->set_markup ($para->{markup});
		3270
		3271	$layout->set_shapes (
		3272	map
		3273	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		3274	@{$para->{widget}}
2536		3275	);
		3276
2537	$layout->size	3277	$layout
2538	}	3278	}
2539		3279
2540	sub reflow {	3280	sub reflow {
2541	my ($self) = @_;	3281	my ($self) = @_;
2542		3282
…		…
2549		3289
2550	# todo: base offset on lines or so, not on pixels	3290	# todo: base offset on lines or so, not on pixels
2551	$self->{children}[1]->set_value ($offset);	3291	$self->{children}[1]->set_value ($offset);
2552	}	3292	}
2553		3293
		3294	sub current_paragraph {
		3295	my ($self) = @_;
		3296
		3297	$self->{top_paragraph} - 1
		3298	}
		3299
		3300	sub scroll_to {
		3301	my ($self, $para) = @_;
		3302
		3303	$para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
		3304
		3305	$self->{scroll_to} = $para;
		3306	$self->update;
		3307	}
		3308
2554	sub clear {	3309	sub clear {
2555	my ($self) = @_;	3310	my ($self) = @_;
		3311
		3312	my (undef, undef, @other) = @{ $self->{children} };
		3313	$self->remove ($_) for @other;
2556		3314
2557	$self->{par} = [];	3315	$self->{par} = [];
2558	$self->{height} = 0;	3316	$self->{height} = 0;
2559	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	3317	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2560	}	3318	}
2561		3319
2562	sub add_paragraph {	3320	sub add_paragraph {
2563	my ($self, $color, $text, $indent) = @_;	3321	my $self = shift;
2564		3322
2565	for my $line (split /\n/, $text) {	3323	for my $para (@_) {
2566	my ($w, $h) = $self->text_size ($line);	3324	$para = {
		3325	fg => [1, 1, 1, 1],
		3326	indent => 0,
		3327	markup => "",
		3328	widget => [],
		3329	ref $para ? %$para : (markup => $para),
		3330	w => 1e10,
		3331	wrapped => 1,
		3332	};
		3333
		3334	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		3335	push @{$self->{par}}, $para;
		3336	}
		3337
		3338	if (my $max = $self->{max_par}) {
		3339	shift @{$self->{par}} while @{$self->{par}} > $max;
		3340	}
		3341
		3342	$self->{need_reflow}++;
		3343	$self->update;
		3344	}
		3345
		3346	sub scroll_to_bottom {
		3347	my ($self) = @_;
		3348
		3349	$self->{scroll_to} = $#{$self->{par}};
		3350	$self->update;
		3351	}
		3352
		3353	sub force_uptodate {
		3354	my ($self) = @_;
		3355
		3356	if (delete $self->{need_reflow}) {
		3357	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		3358
		3359	my $height = 0;
		3360
		3361	for my $para (@{$self->{par}}) {
		3362	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		3363	my $layout = $self->get_layout ($para);
		3364	my ($w, $h) = $layout->size;
		3365
		3366	$para->{w} = $w + $para->{indent};
		3367	$para->{h} = $h;
		3368	$para->{wrapped} = $layout->has_wrapped;
		3369	}
		3370
		3371	$para->{y} = $height;
		3372	$height += $para->{h};
		3373	}
		3374
2567	$self->{height} += $h;	3375	$self->{height} = $height;
2568	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	3376	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2569	}
2570		3377
2571	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	3378	delete $self->{texture};
		3379	}
		3380
		3381	if (my $paridx = delete $self->{scroll_to}) {
		3382	$self->{children}[1]->set_value ($self->{par}[$paridx]{y});
		3383	}
2572	}	3384	}
2573		3385
2574	sub update {	3386	sub update {
2575	my ($self) = @_;	3387	my ($self) = @_;
2576		3388
…		…
2579	return unless $self->{h} > 0;	3391	return unless $self->{h} > 0;
2580		3392
2581	delete $self->{texture};	3393	delete $self->{texture};
2582		3394
2583	$ROOT->on_post_alloc ($self => sub {	3395	$ROOT->on_post_alloc ($self => sub {
		3396	$self->force_uptodate;
		3397
2584	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3398	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2585		3399
2586	if (delete $self->{need_reflow}) {
2587	my $height = 0;
2588
2589	my $layout = $self->{layout};
2590
2591	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2592
2593	for (@{$self->{par}}) {
2594	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2595	$layout->set_width ($W - $_->[3]);
2596	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2597	$layout->set_markup ($_->[4]);
2598	my ($w, $h) = $layout->size;
2599	$_->[0] = $w + $_->[3];
2600	$_->[1] = $h;
2601	}
2602
2603	$height += $_->[1];
2604	}
2605
2606	$self->{height} = $height;
2607
2608	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2609
2610	delete $self->{texture};
2611	}
2612
2613	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	3400	$self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2614	glClearColor 0, 0, 0, 0;	3401	glClearColor 0, 0, 0, 0;
2615	glClear GL_COLOR_BUFFER_BIT;	3402	glClear GL_COLOR_BUFFER_BIT;
2616		3403
		3404	package CFPlus::UI::Base;
		3405	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		3406	(0, 0, $self->{w}, $self->{h});
		3407
		3408	my $top = int $self->{children}[1]{range}[0];
		3409
		3410	my $paridx = 0;
		3411	my $top_paragraph;
2617	my $top = int $self->{children}[1]{range}[0];	3412	my $top = int $self->{children}[1]{range}[0];
2618		3413
2619	my $y0 = $top;	3414	my $y0 = $top;
2620	my $y1 = $top + $H;	3415	my $y1 = $top + $H;
2621		3416
2622	my $y = 0;
2623
2624	my $layout = $self->{layout};
2625
2626	$layout->set_font ($self->{font}) if $self->{font};
2627
2628	glEnable GL_BLEND;
2629	#TODO# not correct in windows where rgba is forced off
2630	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2631
2632	for my $par (@{$self->{par}}) {	3417	for my $para (@{$self->{par}}) {
2633	my $h = $par->[1];	3418	my $h = $para->{h};
		3419	my $y = $para->{y};
2634		3420
2635	if ($y0 < $y + $h && $y < $y1) {	3421	if ($y0 < $y + $h && $y < $y1) {
2636	$layout->set_foreground (@{ $par->[2] });	3422	my $layout = $self->get_layout ($para);
2637	$layout->set_width ($W - $par->[3]);
2638	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2639	$layout->set_markup ($par->[4]);
2640		3423
2641	my ($w, $h, $data, $format, $internalformat) = $layout->render;	3424	$layout->render ($para->{indent}, $y - $y0);
		3425	$layout->draw;
2642		3426
2643	glRasterPos $par->[3], $y - $y0;	3427	if (my @w = @{ $para->{widget} }) {
2644	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	3428	my @s = $layout->get_shapes;
		3429
		3430	for (@w) {
		3431	my ($dx, $dy) = splice @s, 0, 2, ();
		3432
		3433	$_->{x} = $dx + $para->{indent};
		3434	$_->{y} = $dy + $y - $y0;
		3435
		3436	$_->draw;
		3437	}
		3438	}
2645	}	3439	}
2646		3440
2647	$y += $h;	3441	$paridx++;
		3442	$top_paragraph ||= $paridx if $y >= $top;
2648	}	3443	}
2649		3444
2650	glDisable GL_BLEND;	3445	$self->{top_paragraph} = $top_paragraph;
2651	};	3446	};
2652	});	3447	});
		3448	}
		3449
		3450	sub reconfigure {
		3451	my ($self) = @_;
		3452
		3453	$self->SUPER::reconfigure;
		3454
		3455	$_->{w} = 1e10 for @{ $self->{par} };
		3456	$self->reflow;
2653	}	3457	}
2654		3458
2655	sub _draw {	3459	sub _draw {
2656	my ($self) = @_;	3460	my ($self) = @_;
2657		3461
…		…
2660	glColor 0, 0, 0, 1;	3464	glColor 0, 0, 0, 1;
2661	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	3465	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2662	glDisable GL_TEXTURE_2D;	3466	glDisable GL_TEXTURE_2D;
2663		3467
2664	$self->{children}[1]->draw;	3468	$self->{children}[1]->draw;
2665
2666	}	3469	}
2667		3470
2668	#############################################################################	3471	#############################################################################
2669		3472
2670	package CFClient::UI::Animator;	3473	package CFPlus::UI::Animator;
2671		3474
2672	use CFClient::OpenGL;	3475	use CFPlus::OpenGL;
2673		3476
2674	our @ISA = CFClient::UI::Bin::;	3477	our @ISA = CFPlus::UI::Bin::;
2675		3478
2676	sub moveto {	3479	sub moveto {
2677	my ($self, $x, $y) = @_;	3480	my ($self, $x, $y) = @_;
2678		3481
2679	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3482	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2707	glPopMatrix;	3510	glPopMatrix;
2708	}	3511	}
2709		3512
2710	#############################################################################	3513	#############################################################################
2711		3514
2712	package CFClient::UI::Flopper;	3515	package CFPlus::UI::Flopper;
2713		3516
2714	our @ISA = CFClient::UI::Button::;	3517	our @ISA = CFPlus::UI::Button::;
2715		3518
2716	sub new {	3519	sub new {
2717	my $class = shift;	3520	my $class = shift;
2718		3521
2719	my $self = $class->SUPER::new (	3522	my $self = $class->SUPER::new (
…		…
2731	$self->{other}->toggle_visibility;	3534	$self->{other}->toggle_visibility;
2732	}	3535	}
2733		3536
2734	#############################################################################	3537	#############################################################################
2735		3538
2736	package CFClient::UI::Tooltip;	3539	package CFPlus::UI::Tooltip;
2737		3540
2738	our @ISA = CFClient::UI::Bin::;	3541	our @ISA = CFPlus::UI::Bin::;
2739		3542
2740	use CFClient::OpenGL;	3543	use CFPlus::OpenGL;
2741		3544
2742	sub new {	3545	sub new {
2743	my $class = shift;	3546	my $class = shift;
2744		3547
2745	$class->SUPER::new (	3548	$class->SUPER::new (
…		…
2749	}	3552	}
2750		3553
2751	sub set_tooltip_from {	3554	sub set_tooltip_from {
2752	my ($self, $widget) = @_;	3555	my ($self, $widget) = @_;
2753		3556
2754	my $tooltip = $widget->{tooltip};	3557	my $tip = $widget->{tooltip};
		3558	$tip = $tip->($widget) if "CODE" eq ref $tip;
		3559
		3560	$tip = CFPlus::Pod::section_label tooltip => $1
		3561	if $tip =~ /^#(.*)$/;
2755		3562
2756	if ($ENV{CFPLUS_DEBUG} & 2) {	3563	if ($ENV{CFPLUS_DEBUG} & 2) {
2757	$tooltip .= "\n\n" . (ref $widget) . "\n"	3564	$tip .= "\n\n" . (ref $widget) . "\n"
2758	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	3565	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2759	. "req $widget->{req_w} $widget->{req_h}\n"	3566	. "req $widget->{req_w} $widget->{req_h}\n"
2760	. "visible $widget->{visible}";	3567	. "visible $widget->{visible}";
2761	}	3568	}
2762		3569
2763	$tooltip =~ s/^\n+//;	3570	$tip =~ s/^\n+//;
2764	$tooltip =~ s/\n+$//;	3571	$tip =~ s/\n+$//;
2765		3572
2766	$self->add (new CFClient::UI::Label	3573	$self->add (new CFPlus::UI::Label
2767	markup => $tooltip,	3574	markup => $tip,
2768	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3575	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2769	fontsize => 0.8,	3576	fontsize => 0.8,
2770	fg => [0, 0, 0, 1],	3577	style => 1, # FLAG_INVERSE
2771	ellipsise => 0,	3578	ellipsise => 0,
2772	font => ($widget->{tooltip_font} || $::FONT_PROP),	3579	font => ($widget->{tooltip_font} || $::FONT_PROP),
2773	);	3580	);
2774	}	3581	}
2775		3582
…		…
2779	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	3586	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2780		3587
2781	($w + 4, $h + 4)	3588	($w + 4, $h + 4)
2782	}	3589	}
2783		3590
2784	sub size_allocate {	3591	sub invoke_size_allocate {
2785	my ($self, $w, $h) = @_;	3592	my ($self, $w, $h) = @_;
2786		3593
2787	$self->SUPER::size_allocate ($w - 4, $h - 4);	3594	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2788	}	3595	}
2789		3596
2790	sub visibility_change {	3597	sub invoke_visibility_change {
2791	my ($self, $visible) = @_;	3598	my ($self, $visible) = @_;
2792		3599
2793	return unless $visible;	3600	return unless $visible;
2794		3601
2795	$self->{root}->on_post_alloc ("move_$self" => sub {	3602	$self->{root}->on_post_alloc ("move_$self" => sub {
2796	my $widget = $self->{owner}	3603	my $widget = $self->{owner}
2797	or return;	3604	or return;
2798		3605
		3606	if ($widget->{visible}) {
2799	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3607	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2800		3608
2801	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3609	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2802	if $x + $self->{w} > $self->{root}{w};	3610	if $x + $self->{w} > $self->{root}{w};
2803		3611
2804	$self->move_abs ($x, $y);	3612	$self->move_abs ($x, $y);
		3613	} else {
		3614	$self->hide;
		3615	}
2805	});	3616	});
2806	}	3617	}
2807		3618
2808	sub _draw {	3619	sub _draw {
2809	my ($self) = @_;	3620	my ($self) = @_;
2810		3621
2811	glTranslate 0.375, 0.375;
2812
2813	my ($w, $h) = @$self{qw(w h)};	3622	my ($w, $h) = @$self{qw(w h)};
2814		3623
2815	glColor 1, 0.8, 0.4;	3624	glColor 1, 0.8, 0.4;
2816	glBegin GL_QUADS;	3625	glRect 0, 0, $w, $h;
2817	glVertex 0 , 0;
2818	glVertex 0 , $h;
2819	glVertex $w, $h;
2820	glVertex $w, 0;
2821	glEnd;
2822		3626
2823	glColor 0, 0, 0;	3627	glColor 0, 0, 0;
2824	glBegin GL_LINE_LOOP;	3628	glRect_lineloop .5, .5, $w + .5, $h + .5;
2825	glVertex 0 , 0;
2826	glVertex 0 , $h;
2827	glVertex $w, $h;
2828	glVertex $w, 0;
2829	glEnd;
2830		3629
2831	glTranslate 2 - 0.375, 2 - 0.375;	3630	glTranslate 2, 2;
2832		3631
2833	$self->SUPER::_draw;	3632	$self->SUPER::_draw;
2834	}	3633	}
2835		3634
2836	#############################################################################	3635	#############################################################################
2837		3636
2838	package CFClient::UI::Face;	3637	package CFPlus::UI::Face;
2839		3638
2840	our @ISA = CFClient::UI::Base::;	3639	our @ISA = CFPlus::UI::DrawBG::;
2841		3640
2842	use CFClient::OpenGL;	3641	use CFPlus::OpenGL;
2843		3642
2844	sub new {	3643	sub new {
2845	my $class = shift;	3644	my $class = shift;
2846		3645
2847	my $self = $class->SUPER::new (	3646	my $self = $class->SUPER::new (
		3647	size_w => 32,
		3648	size_h => 8,
2848	aspect => 1,	3649	aspect => 1,
2849	can_events => 0,	3650	can_events => 0,
2850	@_,	3651	@_,
2851	);	3652	);
2852		3653
2853	if ($self->{anim} && $self->{animspeed}) {	3654	if ($self->{anim} && $self->{animspeed}) {
2854	Scalar::Util::weaken (my $widget = $self);	3655	CFPlus::weaken (my $widget = $self);
2855		3656
		3657	$widget->{animspeed} = List::Util::max 0.05, $widget->{animspeed};
		3658	$widget->{anim_start} = $self->{animspeed} * int Event::time / $self->{animspeed};
2856	$self->{timer} = Event->timer (	3659	$self->{timer} = Event->timer (
2857	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2858	hard => 1,	3660	parked => 1,
2859	interval => $self->{animspeed},
2860	cb => sub {	3661	cb => sub {
		3662	return unless $::CONN;
		3663
		3664	my $w = $widget
		3665	or return;
		3666
2861	++$widget->{frame};	3667	++$w->{frame};
		3668	$w->update_face;
		3669
		3670	# somehow, $widget can go away
2862	$widget->update;	3671	$w->update;
		3672	$w->update_timer;
2863	},	3673	},
2864	);	3674	);
		3675
		3676	$self->update_face;
		3677	$self->update_timer;
2865	}	3678	}
2866		3679
2867	$self	3680	$self
2868	}	3681	}
2869		3682
		3683	sub update_timer {
		3684	my ($self) = @_;
		3685
		3686	return unless $self->{timer};
		3687
		3688	if ($self->{visible}) {
		3689	$self->{timer}->at (
		3690	$self->{anim_start}
		3691	+ $self->{animspeed}
		3692	* int 1.5 + (Event::time - $self->{anim_start}) / $self->{animspeed}
		3693	);
		3694	$self->{timer}->start;
		3695	} else {
		3696	$self->{timer}->stop;
		3697	}
		3698	}
		3699
		3700	sub update_face {
		3701	my ($self) = @_;
		3702
		3703	if ($::CONN) {
		3704	if (my $anim = $::CONN->{anim}[$self->{anim}]) {
		3705	if ($anim && @$anim) {
		3706	$self->{face} = $anim->[ $self->{frame} % @$anim ];
		3707	delete $self->{face_change_cb};
		3708
		3709	if (my $tex = $self->{tex} = $::CONN->{texture}[ $::CONN->{face}[$self->{face}]{id} ]) {
		3710	unless ($tex->{name} || $tex->{loading}) {
		3711	$tex->upload (sub { $self->reconfigure });
		3712	}
		3713	}
		3714	}
		3715	}
		3716	}
		3717	}
		3718
2870	sub size_request {	3719	sub size_request {
2871	(32, 8)	3720	my ($self) = @_;
		3721
		3722	if ($::CONN) {
		3723	if (my $faceid = $::CONN->{face}[$self->{face}]{id}) {
		3724	if (my $tex = $self->{tex} = $::CONN->{texture}[$faceid]) {
		3725	if ($tex->{name}) {
		3726	return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
		3727	} elsif (!$tex->{loading}) {
		3728	$tex->upload (sub { $self->reconfigure });
		3729	}
		3730	}
		3731
		3732	$self->{face_change_cb} ||= $::CONN->on_face_change ($self->{face}, sub { $self->reconfigure });
		3733	}
		3734	}
		3735
		3736	($self->{size_w} || 8, $self->{size_h} || 8)
2872	}	3737	}
2873		3738
2874	sub update {	3739	sub update {
2875	my ($self) = @_;	3740	my ($self) = @_;
2876		3741
2877	return unless $self->{visible};	3742	return unless $self->{visible};
2878		3743
2879	$self->SUPER::update;	3744	$self->SUPER::update;
2880	}	3745	}
2881		3746
		3747	sub invoke_visibility_change {
		3748	my ($self) = @_;
		3749
		3750	$self->update_timer;
		3751
		3752	0
		3753	}
		3754
2882	sub _draw {	3755	sub _draw {
2883	my ($self) = @_;	3756	my ($self) = @_;
2884		3757
2885	return unless $::CONN;	3758	$self->SUPER::_draw;
2886		3759
2887	my $face;	3760	if (my $tex = $self->{tex}) {
2888
2889	if ($self->{frame}) {
2890	my $anim = $::CONN->{anim}[$self->{anim}];
2891
2892	$face = $anim->[ $self->{frame} % @$anim ]
2893	if $anim && @$anim;
2894	}
2895
2896	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2897
2898	if ($tex) {
2899	glEnable GL_TEXTURE_2D;	3761	glEnable GL_TEXTURE_2D;
2900	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3762	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2901	glColor 0, 0, 0, 1;	3763	glColor 0, 0, 0, 1;
2902	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3764	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2903	glDisable GL_TEXTURE_2D;	3765	glDisable GL_TEXTURE_2D;
…		…
2905	}	3767	}
2906		3768
2907	sub destroy {	3769	sub destroy {
2908	my ($self) = @_;	3770	my ($self) = @_;
2909		3771
2910	$self->{timer}->cancel	3772	(delete $self->{timer})->cancel
2911	if $self->{timer};	3773	if $self->{timer};
2912		3774
2913	$self->SUPER::destroy;	3775	$self->SUPER::destroy;
2914	}	3776	}
2915		3777
2916	#############################################################################	3778	#############################################################################
2917		3779
2918	package CFClient::UI::Buttonbar;	3780	package CFPlus::UI::Buttonbar;
2919		3781
2920	our @ISA = CFClient::UI::HBox::;	3782	our @ISA = CFPlus::UI::HBox::;
2921		3783
2922	# TODO: should actualyl wrap buttons and other goodies.	3784	# TODO: should actually wrap buttons and other goodies.
2923		3785
2924	#############################################################################	3786	#############################################################################
2925		3787
2926	package CFClient::UI::Menu;	3788	package CFPlus::UI::Menu;
2927		3789
2928	our @ISA = CFClient::UI::FancyFrame::;	3790	our @ISA = CFPlus::UI::Toplevel::;
2929		3791
2930	use CFClient::OpenGL;	3792	use CFPlus::OpenGL;
2931		3793
2932	sub new {	3794	sub new {
2933	my $class = shift;	3795	my $class = shift;
2934		3796
2935	my $self = $class->SUPER::new (	3797	my $self = $class->SUPER::new (
2936	items => [],	3798	items => [],
2937	z => 100,	3799	z => 100,
2938	@_,	3800	@_,
2939	);	3801	);
2940		3802
2941	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3803	$self->add ($self->{vbox} = new CFPlus::UI::VBox);
2942		3804
2943	for my $item (@{ $self->{items} }) {	3805	for my $item (@{ $self->{items} }) {
2944	my ($widget, $cb, $tooltip) = @$item;	3806	my ($widget, $cb, $tooltip) = @$item;
2945		3807
2946	# handle various types of items, only text for now	3808	# handle various types of items, only text for now
2947	if (!ref $widget) {	3809	if (!ref $widget) {
		3810	if ($widget =~ /\t/) {
		3811	my ($left, $right) = split /\t/, $widget, 2;
		3812
2948	$widget = new CFClient::UI::Label	3813	$widget = new CFPlus::UI::HBox
2949	can_hover => 1,	3814	can_hover => 1,
2950	can_events => 1,	3815	can_events => 1,
		3816	tooltip => $tooltip,
		3817	children => [
		3818	(new CFPlus::UI::Label markup => $left, expand => 1),
		3819	(new CFPlus::UI::Label markup => $right, align => +1),
		3820	],
		3821	;
		3822
		3823	} else {
		3824	$widget = new CFPlus::UI::Label
		3825	can_hover => 1,
		3826	can_events => 1,
2951	markup => $widget,	3827	markup => $widget,
2952	tooltip => $tooltip	3828	tooltip => $tooltip;
		3829	}
2953	}	3830	}
2954		3831
2955	$self->{item}{$widget} = $item;	3832	$self->{item}{$widget} = $item;
2956		3833
2957	$self->{vbox}->add ($widget);	3834	$self->{vbox}->add ($widget);
…		…
2962		3839
2963	# popup given the event (must be a mouse button down event currently)	3840	# popup given the event (must be a mouse button down event currently)
2964	sub popup {	3841	sub popup {
2965	my ($self, $ev) = @_;	3842	my ($self, $ev) = @_;
2966		3843
2967	$self->_emit ("popdown");	3844	$self->emit ("popdown");
2968		3845
2969	# maybe save $GRAB? must be careful about events...	3846	# maybe save $GRAB? must be careful about events...
2970	$GRAB = $self;	3847	$GRAB = $self;
2971	$self->{button} = $ev->{button};	3848	$self->{button} = $ev->{button};
2972		3849
2973	$self->show;	3850	$self->show;
2974	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3851	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2975	}	3852	}
2976		3853
2977	sub mouse_motion {	3854	sub invoke_mouse_motion {
2978	my ($self, $ev, $x, $y) = @_;	3855	my ($self, $ev, $x, $y) = @_;
2979		3856
2980	# TODO: should use vbox->find_widget or so	3857	# TODO: should use vbox->find_widget or so
2981	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3858	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2982	$self->{hover} = $self->{item}{$HOVER};	3859	$self->{hover} = $self->{item}{$HOVER};
2983		3860
2984	0	3861	0
2985	}	3862	}
2986		3863
2987	sub button_up {	3864	sub invoke_button_up {
2988	my ($self, $ev, $x, $y) = @_;	3865	my ($self, $ev, $x, $y) = @_;
2989		3866
2990	if ($ev->{button} == $self->{button}) {	3867	if ($ev->{button} == $self->{button}) {
2991	undef $GRAB;	3868	undef $GRAB;
2992	$self->hide;	3869	$self->hide;
2993		3870
2994	$self->_emit ("popdown");	3871	$self->emit ("popdown");
2995	$self->{hover}[1]->() if $self->{hover};	3872	$self->{hover}[1]->() if $self->{hover};
2996	} else {	3873	} else {
2997	return 0	3874	return 0
2998	}	3875	}
2999		3876
3000	1	3877	1
3001	}	3878	}
3002		3879
3003	#############################################################################	3880	#############################################################################
3004		3881
3005	package CFClient::UI::Multiplexer;	3882	package CFPlus::UI::Multiplexer;
3006		3883
3007	our @ISA = CFClient::UI::Container::;	3884	our @ISA = CFPlus::UI::Container::;
3008		3885
3009	sub new {	3886	sub new {
3010	my $class = shift;	3887	my $class = shift;
3011		3888
3012	my $self = $class->SUPER::new (	3889	my $self = $class->SUPER::new (
…		…
3026		3903
3027	$self->{current} = $self->{children}[0]	3904	$self->{current} = $self->{children}[0]
3028	if @{ $self->{children} };	3905	if @{ $self->{children} };
3029	}	3906	}
3030		3907
		3908	sub get_current_page {
		3909	my ($self) = @_;
		3910
		3911	$self->{current}
		3912	}
		3913
3031	sub set_current_page {	3914	sub set_current_page {
3032	my ($self, $page_or_widget) = @_;	3915	my ($self, $page_or_widget) = @_;
3033		3916
3034	my $widget = ref $page_or_widget	3917	my $widget = ref $page_or_widget
3035	? $page_or_widget	3918	? $page_or_widget
3036	: $self->{children}[$page_or_widget];	3919	: $self->{children}[$page_or_widget];
3037		3920
3038	$self->{current} = $widget;	3921	$self->{current} = $widget;
3039	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3922	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3040		3923
3041	$self->_emit (page_changed => $self->{current});	3924	$self->emit (page_changed => $self->{current});
3042		3925
3043	$self->realloc;	3926	$self->realloc;
3044	}	3927	}
3045		3928
3046	sub visible_children {	3929	sub visible_children {
…		…
3051	my ($self) = @_;	3934	my ($self) = @_;
3052		3935
3053	$self->{current}->size_request	3936	$self->{current}->size_request
3054	}	3937	}
3055		3938
3056	sub size_allocate {	3939	sub invoke_size_allocate {
3057	my ($self, $w, $h) = @_;	3940	my ($self, $w, $h) = @_;
3058		3941
3059	$self->{current}->configure (0, 0, $w, $h);	3942	$self->{current}->configure (0, 0, $w, $h);
		3943
		3944	1
3060	}	3945	}
3061		3946
3062	sub _draw {	3947	sub _draw {
3063	my ($self) = @_;	3948	my ($self) = @_;
3064		3949
3065	$self->{current}->draw;	3950	$self->{current}->draw;
3066	}	3951	}
3067		3952
3068	#############################################################################	3953	#############################################################################
3069		3954
3070	package CFClient::UI::Notebook;	3955	package CFPlus::UI::Notebook;
3071		3956
		3957	use CFPlus::OpenGL;
		3958
3072	our @ISA = CFClient::UI::VBox::;	3959	our @ISA = CFPlus::UI::VBox::;
3073		3960
3074	sub new {	3961	sub new {
3075	my $class = shift;	3962	my $class = shift;
3076		3963
3077	my $self = $class->SUPER::new (	3964	my $self = $class->SUPER::new (
3078	buttonbar => (new CFClient::UI::Buttonbar),	3965	buttonbar => (new CFPlus::UI::Buttonbar),
3079	multiplexer => (new CFClient::UI::Multiplexer expand => 1),	3966	multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
		3967	active_outline => [.7, .7, 0.2],
3080	# filter => # will be put between multiplexer and $self	3968	# filter => # will be put between multiplexer and $self
3081	@_,	3969	@_,
3082	);	3970	);
3083		3971
3084	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};	3972	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3085	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});	3973	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
3086		3974
		3975	{
		3976	Scalar::Util::weaken (my $wself = $self);
		3977
		3978	$self->{multiplexer}->connect (c_add => sub {
		3979	my ($mplex, $widgets) = @_;
		3980
		3981	for my $child (@$widgets) {
		3982	Scalar::Util::weaken $child;
		3983	$child->{c_tab_} ||= do {
		3984	my $tab =
		3985	(UNIVERSAL::isa $child->{c_tab}, "CFPlus::UI::Base")
		3986	? $child->{c_tab}
		3987	: new CFPlus::UI::Button markup => $child->{c_tab}[0], tooltip => $child->{c_tab}[1];
		3988
		3989	$tab->connect (activate => sub {
		3990	$wself->set_current_page ($child);
		3991	});
		3992
		3993	$tab
		3994	};
		3995
		3996	$self->{buttonbar}->add ($child->{c_tab_});
		3997	}
		3998	});
		3999
		4000	$self->{multiplexer}->connect (c_remove => sub {
		4001	my ($mplex, $widgets) = @_;
		4002
		4003	for my $child (@$widgets) {
		4004	$wself->{buttonbar}->remove ($child->{c_tab_});
		4005	}
		4006	});
		4007	}
		4008
3087	$self	4009	$self
3088	}	4010	}
3089		4011
3090	sub add {	4012	sub add {
		4013	my ($self, @widgets) = @_;
		4014
		4015	$self->{multiplexer}->add (@widgets)
		4016	}
		4017
		4018	sub remove {
		4019	my ($self, @widgets) = @_;
		4020
		4021	$self->{multiplexer}->remove (@widgets)
		4022	}
		4023
		4024	sub pages {
		4025	my ($self) = @_;
		4026	$self->{multiplexer}->children
		4027	}
		4028
		4029	sub add_tab {
3091	my ($self, $title, $widget, $tooltip) = @_;	4030	my ($self, $title, $widget, $tooltip) = @_;
3092		4031
3093	Scalar::Util::weaken $self;	4032	$title = [$title, $tooltip] unless ref $title;
		4033	$widget->{c_tab} = $title;
3094		4034
3095	$self->{buttonbar}->add (new CFClient::UI::Button
3096	markup => $title,
3097	tooltip => $tooltip,
3098	on_activate => sub { $self->set_current_page ($widget) },
3099	);
3100
3101	$self->{multiplexer}->add ($widget);	4035	$self->add ($widget);
		4036	}
		4037
		4038	sub get_current_page {
		4039	my ($self) = @_;
		4040
		4041	$self->{multiplexer}->get_current_page
3102	}	4042	}
3103		4043
3104	sub set_current_page {	4044	sub set_current_page {
3105	my ($self, $page) = @_;	4045	my ($self, $page) = @_;
3106		4046
3107	$self->{multiplexer}->set_current_page ($page);	4047	$self->{multiplexer}->set_current_page ($page);
3108	$self->_emit (page_changed => $self->{multiplexer}{current});	4048	$self->emit (page_changed => $self->{multiplexer}{current});
		4049	}
		4050
		4051	sub _draw {
		4052	my ($self) = @_;
		4053
		4054	$self->SUPER::_draw ();
		4055
		4056	if (my $cur = $self->{multiplexer}{current}) {
		4057	if ($cur = $cur->{c_tab_}) {
		4058	glTranslate $self->{buttonbar}{x} + $cur->{x},
		4059	$self->{buttonbar}{y} + $cur->{y};
		4060	glLineWidth 3;
		4061	#glEnable GL_BLEND;
		4062	#glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
		4063	glColor @{$self->{active_outline}};
		4064	glRect_lineloop 1.5, 1.5, $cur->{w} - 1.5, $cur->{h} - 1.5;
		4065	glLineWidth 1;
		4066	#glDisable GL_BLEND;
		4067	}
		4068	}
3109	}	4069	}
3110		4070
3111	#############################################################################	4071	#############################################################################
3112		4072
3113	package CFClient::UI::Combobox;	4073	package CFPlus::UI::Selector;
3114		4074
3115	use utf8;	4075	use utf8;
3116		4076
3117	our @ISA = CFClient::UI::Button::;	4077	our @ISA = CFPlus::UI::Button::;
3118		4078
3119	sub new {	4079	sub new {
3120	my $class = shift;	4080	my $class = shift;
3121		4081
3122	my $self = $class->SUPER::new (	4082	my $self = $class->SUPER::new (
…		…
3128	$self->_set_value ($self->{value});	4088	$self->_set_value ($self->{value});
3129		4089
3130	$self	4090	$self
3131	}	4091	}
3132		4092
3133	sub button_down {	4093	sub invoke_button_down {
3134	my ($self, $ev) = @_;	4094	my ($self, $ev) = @_;
3135		4095
3136	my @menu_items;	4096	my @menu_items;
3137		4097
3138	for (@{ $self->{options} }) {	4098	for (@{ $self->{options} }) {
3139	my ($value, $title, $tooltip) = @$_;	4099	my ($value, $title, $tooltip) = @$_;
3140		4100
3141	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];	4101	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3142	}	4102	}
3143		4103
3144	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);	4104	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
3145	}	4105	}
3146		4106
3147	sub _set_value {	4107	sub _set_value {
3148	my ($self, $value) = @_;	4108	my ($self, $value) = @_;
3149		4109
…		…
3159	my ($self, $value) = @_;	4119	my ($self, $value) = @_;
3160		4120
3161	return unless $self->{value} ne $value;	4121	return unless $self->{value} ne $value;
3162		4122
3163	$self->_set_value ($value);	4123	$self->_set_value ($value);
3164	$self->_emit (changed => $value);	4124	$self->emit (changed => $value);
3165	}	4125	}
3166		4126
3167	#############################################################################	4127	#############################################################################
3168		4128
3169	package CFClient::UI::Statusbox;	4129	package CFPlus::UI::Statusbox;
3170		4130
3171	our @ISA = CFClient::UI::VBox::;	4131	our @ISA = CFPlus::UI::VBox::;
3172		4132
3173	sub new {	4133	sub new {
3174	my $class = shift;	4134	my $class = shift;
3175		4135
3176	my $self = $class->SUPER::new (	4136	my $self = $class->SUPER::new (
3177	fontsize => 0.8,	4137	fontsize => 0.8,
3178	@_,	4138	@_,
3179	);	4139	);
3180		4140
3181	Scalar::Util::weaken (my $this = $self);	4141	CFPlus::weaken (my $this = $self);
3182		4142
3183	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });	4143	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
3184		4144
3185	$self	4145	$self
3186	}	4146	}
…		…
3188	sub reorder {	4148	sub reorder {
3189	my ($self) = @_;	4149	my ($self) = @_;
3190	my $NOW = Time::HiRes::time;	4150	my $NOW = Time::HiRes::time;
3191		4151
3192	# freeze display when hovering over any label	4152	# freeze display when hovering over any label
3193	return if $CFClient::UI::TOOLTIP->{owner}	4153	return if $CFPlus::UI::TOOLTIP->{owner}
3194	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},	4154	&& grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
3195	values %{ $self->{item} };	4155	values %{ $self->{item} };
3196		4156
3197	while (my ($k, $v) = each %{ $self->{item} }) {	4157	while (my ($k, $v) = each %{ $self->{item} }) {
3198	delete $self->{item}{$k} if $v->{timeout} < $NOW;	4158	delete $self->{item}{$k} if $v->{timeout} < $NOW;
3199	}	4159	}
…		…
3220	for ($short) {	4180	for ($short) {
3221	s/^\s+//;	4181	s/^\s+//;
3222	s/\s+/ /g;	4182	s/\s+/ /g;
3223	}	4183	}
3224		4184
3225	new CFClient::UI::Label	4185	new CFPlus::UI::Label
3226	markup => $short,	4186	markup => $short,
3227	tooltip => $item->{tooltip},	4187	tooltip => $item->{tooltip},
3228	tooltip_font => $::FONT_PROP,	4188	tooltip_font => $::FONT_PROP,
3229	tooltip_width => 0.67,	4189	tooltip_width => 0.67,
3230	fontsize => $item->{fontsize} || $self->{fontsize},	4190	fontsize => $item->{fontsize} || $self->{fontsize},
…		…
3284	count => 1,	4244	count => 1,
3285	%arg,	4245	%arg,
3286	};	4246	};
3287	}	4247	}
3288		4248
		4249	$ROOT->on_refresh (reorder => sub {
3289	$self->reorder;	4250	$self->reorder;
		4251	});
3290	}	4252	}
3291		4253
3292	sub reconfigure {	4254	sub reconfigure {
3293	my ($self) = @_;	4255	my ($self) = @_;
3294		4256
…		…
3307	$self->SUPER::destroy;	4269	$self->SUPER::destroy;
3308	}	4270	}
3309		4271
3310	#############################################################################	4272	#############################################################################
3311		4273
3312	package CFClient::UI::Inventory;
3313
3314	our @ISA = CFClient::UI::ScrolledWindow::;
3315
3316	sub new {
3317	my $class = shift;
3318
3319	my $self = $class->SUPER::new (
3320	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3321	@_,
3322	);
3323
3324	$self
3325	}
3326
3327	sub set_items {
3328	my ($self, $items) = @_;
3329
3330	$self->{child}->clear;
3331	return unless $items;
3332
3333	my @items = sort {
3334	($a->{type} <=> $b->{type})
3335	or ($a->{name} cmp $b->{name})
3336	} @$items;
3337
3338	$self->{real_items} = \@items;
3339
3340	my $row = 0;
3341	for my $item (@items) {
3342	CFClient::Item::update_widgets $item;
3343
3344	$self->{child}->add (0, $row, $item->{face_widget});
3345	$self->{child}->add (1, $row, $item->{desc_widget});
3346	$self->{child}->add (2, $row, $item->{weight_widget});
3347
3348	$row++;
3349	}
3350	}
3351
3352	#############################################################################
3353
3354	package CFClient::UI::BindEditor;
3355
3356	our @ISA = CFClient::UI::FancyFrame::;
3357
3358	sub new {
3359	my $class = shift;
3360
3361	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3362
3363	$self->add (my $vb = new CFClient::UI::VBox);
3364
3365
3366	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3367	text => "start recording",
3368	tooltip => "Start/Stops recording of actions."
3369	."All subsequent actions after the recording started will be captured."
3370	."The actions are displayed after the record was stopped."
3371	."To bind the action you have to click on the 'Bind' button",
3372	on_activate => sub {
3373	unless ($self->{recording}) {
3374	$self->start;
3375	} else {
3376	$self->stop;
3377	}
3378	});
3379
3380	$vb->add (new CFClient::UI::Label text => "Actions:");
3381	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3382
3383	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3384	$vb->add (my $hb = new CFClient::UI::HBox);
3385	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3386	$hb->add (new CFClient::UI::Button
3387	text => "bind",
3388	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3389	on_activate => sub {
3390	$self->ask_for_bind;
3391	});
3392
3393	$vb->add (my $hb = new CFClient::UI::HBox);
3394	$hb->add (new CFClient::UI::Button
3395	text => "ok",
3396	expand => 1,
3397	tooltip => "This closes the binding editor and saves the binding",
3398	on_activate => sub {
3399	$self->hide;
3400	$self->commit;
3401	});
3402
3403	$hb->add (new CFClient::UI::Button
3404	text => "cancel",
3405	expand => 1,
3406	tooltip => "This closes the binding editor without saving",
3407	on_activate => sub {
3408	$self->hide;
3409	$self->{binding_cancel}->()
3410	if $self->{binding_cancel};
3411	});
3412
3413	$self->update_binding_widgets;
3414
3415	$self
3416	}
3417
3418	sub commit {
3419	my ($self) = @_;
3420	my ($mod, $sym, $cmds) = $self->get_binding;
3421	if ($sym != 0 && @$cmds > 0) {
3422	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3423	."'. Don't forget 'Save Config'!");
3424	$self->{binding_change}->($mod, $sym, $cmds)
3425	if $self->{binding_change};
3426	} else {
3427	$::STATUSBOX->add ("No action bound, no key or action specified!");
3428	$self->{binding_cancel}->()
3429	if $self->{binding_cancel};
3430	}
3431	}
3432
3433	sub start {
3434	my ($self) = @_;
3435
3436	$self->{rec_btn}->set_text ("stop recording");
3437	$self->{recording} = 1;
3438	$self->clear_command_list;
3439	$::CONN->start_record if $::CONN;
3440	}
3441
3442	sub stop {
3443	my ($self) = @_;
3444
3445	$self->{rec_btn}->set_text ("start recording");
3446	$self->{recording} = 0;
3447
3448	my $rec;
3449	$rec = $::CONN->stop_record if $::CONN;
3450	return unless ref $rec eq 'ARRAY';
3451	$self->set_command_list ($rec);
3452	}
3453
3454
3455	sub ask_for_bind_and_commit {
3456	my ($self) = @_;
3457	$self->ask_for_bind (1);
3458	}
3459
3460	sub ask_for_bind {
3461	my ($self, $commit) = @_;
3462
3463	CFClient::Binder::open_binding_dialog (sub {
3464	my ($mod, $sym) = @_;
3465	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3466	$self->update_binding_widgets;
3467	$self->commit if $commit;
3468	});
3469	}
3470
3471	# $mod and $sym are the modifiers and key symbol
3472	# $cmds is a array ref of strings (the commands)
3473	# $cb is the callback that is executed on OK
3474	# $ccb is the callback that is executed on CANCEL and
3475	# when the binding was unsuccessful on OK
3476	sub set_binding {
3477	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3478
3479	$self->clear_command_list;
3480	$self->{recording} = 0;
3481	$self->{rec_btn}->set_text ("start recording");
3482
3483	$self->{binding} = [$mod, $sym];
3484	$self->{commands} = $cmds;
3485
3486	$self->{binding_change} = $cb;
3487	$self->{binding_cancel} = $ccb;
3488
3489	$self->update_binding_widgets;
3490	}
3491
3492	# this is a shortcut method that asks for a binding
3493	# and then just binds it.
3494	sub do_quick_binding {
3495	my ($self, $cmds) = @_;
3496	$self->set_binding (undef, undef, $cmds, sub {
3497	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3498	});
3499	$self->ask_for_bind (1);
3500	}
3501
3502	sub update_binding_widgets {
3503	my ($self) = @_;
3504	my ($mod, $sym, $cmds) = $self->get_binding;
3505	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3506	$self->set_command_list ($cmds);
3507	}
3508
3509	sub get_binding {
3510	my ($self) = @_;
3511	return (
3512	$self->{binding}->[0],
3513	$self->{binding}->[1],
3514	[ grep { defined $_ } @{$self->{commands}} ]
3515	);
3516	}
3517
3518	sub clear_command_list {
3519	my ($self) = @_;
3520	$self->{cmdbox}->clear ();
3521	}
3522
3523	sub set_command_list {
3524	my ($self, $cmds) = @_;
3525
3526	$self->{cmdbox}->clear ();
3527	$self->{commands} = $cmds;
3528
3529	my $idx = 0;
3530
3531	for (@$cmds) {
3532	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3533
3534	my $i = $idx;
3535	$hb->add (new CFClient::UI::Label text => $_);
3536	$hb->add (new CFClient::UI::Button
3537	text => "delete",
3538	tooltip => "Deletes the action from the record",
3539	on_activate => sub {
3540	$self->{cmdbox}->remove ($hb);
3541	$cmds->[$i] = undef;
3542	});
3543
3544
3545	$idx++
3546	}
3547	}
3548
3549	#############################################################################
3550
3551	package CFClient::UI::SpellList;
3552
3553	our @ISA = CFClient::UI::Table::;
3554
3555	sub new {
3556	my $class = shift;
3557
3558	my $self = $class->SUPER::new (
3559	binding => [],
3560	commands => [],
3561	@_,
3562	)
3563	}
3564
3565	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
3566
3567	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3568	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
3569	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3570	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
3571	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3572	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
3573	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3574	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
3575	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3576	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
3577
3578	sub rebuild_spell_list {
3579	my ($self) = @_;
3580
3581	$CFClient::UI::ROOT->on_refresh ($self => sub {
3582	$self->clear;
3583
3584	return unless $::CONN;
3585
3586	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3587	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3588	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3589	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3590	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3591
3592	my $row = 0;
3593
3594	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3595	my $spell = $self->{spell}{$_};
3596
3597	$row++;
3598
3599	my $spell_cb = sub {
3600	my ($widget, $ev) = @_;
3601
3602	if ($ev->{button} == 1) {
3603	$::CONN->user_send ("cast $spell->{name}");
3604	} elsif ($ev->{button} == 2) {
3605	$::CONN->user_send ("invoke $spell->{name}");
3606	} elsif ($ev->{button} == 3) {
3607	(new CFClient::UI::Menu
3608	items => [
3609	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3610	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3611	],
3612	)->popup ($ev);
3613	} else {
3614	return 0;
3615	}
3616
3617	1
3618	};
3619
3620	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
3621
3622	#TODO: add path info to tooltip
3623	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
3624
3625	$self->add (0, $row, new CFClient::UI::Face
3626	face => $spell->{face},
3627	can_hover => 1,
3628	can_events => 1,
3629	tooltip => $tooltip,
3630	on_button_down => $spell_cb,
3631	);
3632
3633	$self->add (1, $row, new CFClient::UI::Label
3634	expand => 1,
3635	text => $spell->{name},
3636	can_hover => 1,
3637	can_events => 1,
3638	tooltip => $tooltip,
3639	on_button_down => $spell_cb,
3640	);
3641
3642	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
3643	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3644	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3645	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3646	}
3647	});
3648	}
3649
3650	sub add_spell {
3651	my ($self, $spell) = @_;
3652
3653	$self->{spell}->{$spell->{name}} = $spell;
3654	$self->rebuild_spell_list;
3655	}
3656
3657	sub remove_spell {
3658	my ($self, $spell) = @_;
3659
3660	delete $self->{spell}->{$spell->{name}};
3661	$self->rebuild_spell_list;
3662	}
3663
3664	sub clear_spells {
3665	my ($self) = @_;
3666
3667	$self->{spell} = {};
3668	$self->rebuild_spell_list;
3669	}
3670
3671	#############################################################################
3672
3673	package CFClient::UI::Root;	4274	package CFPlus::UI::Root;
3674		4275
3675	our @ISA = CFClient::UI::Container::;	4276	our @ISA = CFPlus::UI::Container::;
3676		4277
3677	use List::Util qw(min max);	4278	use List::Util qw(min max);
3678		4279
3679	use CFClient::OpenGL;	4280	use CFPlus::OpenGL;
3680		4281
3681	sub new {	4282	sub new {
3682	my $class = shift;	4283	my $class = shift;
3683		4284
3684	my $self = $class->SUPER::new (	4285	my $self = $class->SUPER::new (
3685	visible => 1,	4286	visible => 1,
3686	@_,	4287	@_,
3687	);	4288	);
3688		4289
3689	Scalar::Util::weaken ($self->{root} = $self);	4290	CFPlus::weaken ($self->{root} = $self);
3690		4291
3691	$self	4292	$self
3692	}	4293	}
3693		4294
3694	sub size_request {	4295	sub size_request {
…		…
3709	$coord = $max - $size if $coord > $max - $size;	4310	$coord = $max - $size if $coord > $max - $size;
3710		4311
3711	int $coord + 0.5	4312	int $coord + 0.5
3712	}	4313	}
3713		4314
3714	sub size_allocate {	4315	sub invoke_size_allocate {
3715	my ($self, $w, $h) = @_;	4316	my ($self, $w, $h) = @_;
3716		4317
3717	for my $child ($self->children) {	4318	for my $child ($self->children) {
3718	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	4319	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3719		4320
…		…
3723	$X = _to_pixel $X, $W, $self->{w};	4324	$X = _to_pixel $X, $W, $self->{w};
3724	$Y = _to_pixel $Y, $H, $self->{h};	4325	$Y = _to_pixel $Y, $H, $self->{h};
3725		4326
3726	$child->configure ($X, $Y, $W, $H);	4327	$child->configure ($X, $Y, $W, $H);
3727	}	4328	}
		4329
		4330	1
3728	}	4331	}
3729		4332
3730	sub coord2local {	4333	sub coord2local {
3731	my ($self, $x, $y) = @_;	4334	my ($self, $x, $y) = @_;
3732		4335
…		…
3740	}	4343	}
3741		4344
3742	sub update {	4345	sub update {
3743	my ($self) = @_;	4346	my ($self) = @_;
3744		4347
3745	$::WANT_REFRESH++;	4348	$::WANT_REFRESH->start;
3746	}	4349	}
3747		4350
3748	sub add {	4351	sub add {
3749	my ($self, @children) = @_;	4352	my ($self, @children) = @_;
3750		4353
…		…
3787	while ($self->{refresh_hook}) {	4390	while ($self->{refresh_hook}) {
3788	$_->()	4391	$_->()
3789	for values %{delete $self->{refresh_hook}};	4392	for values %{delete $self->{refresh_hook}};
3790	}	4393	}
3791		4394
3792	if ($self->{realloc}) {	4395	while ($self->{realloc}) {
3793	my %queue;	4396	my %queue;
3794	my @queue;	4397	my @queue;
3795	my $widget;	4398	my $widget;
3796		4399
3797	outer:	4400	outer:
…		…
3844	}	4447	}
3845	}	4448	}
3846		4449
3847	delete $self->{realloc}{$widget+0};	4450	delete $self->{realloc}{$widget+0};
3848	}	4451	}
3849	}
3850		4452
3851	while (my $size_alloc = delete $self->{size_alloc}) {	4453	while (my $size_alloc = delete $self->{size_alloc}) {
3852	my @queue = sort { $b->{visible} <=> $a->{visible} }	4454	my @queue = sort { $a->{visible} <=> $b->{visible} }
3853	values %$size_alloc;	4455	values %$size_alloc;
3854		4456
3855	while () {	4457	while () {
3856	my $widget = pop @queue || last;	4458	my $widget = pop @queue || last;
3857		4459
3858	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	4460	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3859		4461
3860	$w = 0 if $w < 0;	4462	$w = max $widget->{min_w}, $w;
3861	$h = 0 if $h < 0;	4463	$h = max $widget->{min_h}, $h;
3862		4464
		4465	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		4466	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		4467
		4468	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		4469	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		4470
3863	$w = int $w + 0.5;	4471	$w = int $w + 0.5;
3864	$h = int $h + 0.5;	4472	$h = int $h + 0.5;
3865		4473
3866	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	4474	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3867	$widget->{old_w} = $widget->{w};	4475	$widget->{old_w} = $widget->{w};
3868	$widget->{old_h} = $widget->{h};	4476	$widget->{old_h} = $widget->{h};
3869		4477
3870	$widget->{w} = $w;	4478	$widget->{w} = $w;
3871	$widget->{h} = $h;	4479	$widget->{h} = $h;
3872		4480
3873	$widget->emit (size_allocate => $w, $h);	4481	$widget->emit (size_allocate => $w, $h);
		4482	}
3874	}	4483	}
3875	}	4484	}
3876	}	4485	}
3877		4486
3878	while ($self->{post_alloc_hook}) {	4487	while ($self->{post_alloc_hook}) {
3879	$_->()	4488	$_->()
3880	for values %{delete $self->{post_alloc_hook}};	4489	for values %{delete $self->{post_alloc_hook}};
3881	}	4490	}
3882
3883		4491
3884	glViewport 0, 0, $::WIDTH, $::HEIGHT;	4492	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3885	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	4493	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3886	glClear GL_COLOR_BUFFER_BIT;	4494	glClear GL_COLOR_BUFFER_BIT;
3887		4495
…		…
3890	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4498	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3891	glMatrixMode GL_MODELVIEW;	4499	glMatrixMode GL_MODELVIEW;
3892	glLoadIdentity;	4500	glLoadIdentity;
3893		4501
3894	{	4502	{
3895	package CFClient::UI::Base;	4503	package CFPlus::UI::Base;
3896		4504
3897	($draw_x, $draw_y, $draw_w, $draw_h) =	4505	local ($draw_x, $draw_y, $draw_w, $draw_h) =
3898	(0, 0, $self->{w}, $self->{h});	4506	(0, 0, $self->{w}, $self->{h});
3899	}
3900		4507
3901	$self->_draw;	4508	$self->_draw;
		4509	}
3902	}	4510	}
3903		4511
3904	#############################################################################	4512	#############################################################################
3905		4513
3906	package CFClient::UI;	4514	package CFPlus::UI;
3907		4515
3908	$ROOT = new CFClient::UI::Root;	4516	$ROOT = new CFPlus::UI::Root;
3909	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4517	$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
3910		4518
3911	1	4519	1
3912		4520

Diff Legend

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