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

Diff Legend

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