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

Diff Legend

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