ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.286 by root, Mon Jun 5 03:48:49 2006 UTC vs.
Revision 1.428 by root, Mon Aug 20 19:24:22 2007 UTC

1	package CFClient::UI;	1	package CFPlus::UI;
2		2
3	use utf8;	3	use utf8;
4	use strict;	4	use strict;
5		5
6	use Scalar::Util ();
7	use List::Util ();	6	use List::Util ();
8	use Event;	7	use Event;
9		8
10	use CFClient;	9	use CFPlus;
		10	use CFPlus::Pod;
11	use CFClient::Texture;	11	use CFPlus::Texture;
12		12
13	our ($FOCUS, $HOVER, $GRAB); # various widgets	13	our ($FOCUS, $HOVER, $GRAB); # various widgets
14		14
15	our $LAYOUT;	15	our $LAYOUT;
16	our $ROOT;	16	our $ROOT;
…		…
22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {	22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
23	if (!$GRAB) {	23	if (!$GRAB) {
24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
25	if (length $widget->{tooltip}) {	25	if (length $widget->{tooltip}) {
26	if ($TOOLTIP->{owner} != $widget) {	26	if ($TOOLTIP->{owner} != $widget) {
		27	$TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
27	$TOOLTIP->hide;	28	$TOOLTIP->hide;
28		29
29	$TOOLTIP->{owner} = $widget;	30	$TOOLTIP->{owner} = $widget;
		31	$TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner};
30		32
31	return if $ENV{CFPLUS_DEBUG} & 8;	33	return if $ENV{CFPLUS_DEBUG} & 8;
32		34
33	my $tip = $widget->{tooltip};	35	my $tip = $widget->{tooltip};
34		36
…		…
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);
		2049
		2050	$self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1651	};	2051	};
1652		2052
1653	glEnable GL_TEXTURE_2D;	2053	# unless ($self->{list}) {
1654	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2054	# $self->{list} = CFPlus::OpenGL::glGenList;
1655		2055	# CFPlus::OpenGL::glNewList $self->{list};
1656	if ($tex->{format} == GL_ALPHA) {	2056	# $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1657	glColor @{$self->{fg}};	2057	# CFPlus::OpenGL::glEndList;
1658	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1659	} else {
1660	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1661	}	2058	# }
		2059	#
		2060	# CFPlus::OpenGL::glCallList $self->{list};
1662		2061
1663	glDisable GL_TEXTURE_2D;	2062	$self->{layout}->draw;
1664	}	2063	}
		2064
		2065	#sub destroy {
		2066	# my ($self) = @_;
		2067	#
		2068	# CFPlus::OpenGL::glDeleteList delete $self->{list} if $self->{list};
		2069	#
		2070	# $self->SUPER::destroy;
		2071	#}
1665		2072
1666	#############################################################################	2073	#############################################################################
1667		2074
1668	package CFClient::UI::EntryBase;	2075	package CFPlus::UI::EntryBase;
1669		2076
1670	our @ISA = CFClient::UI::Label::;	2077	our @ISA = CFPlus::UI::Label::;
1671		2078
1672	use CFClient::OpenGL;	2079	use CFPlus::OpenGL;
1673		2080
1674	sub new {	2081	sub new {
1675	my $class = shift;	2082	my $class = shift;
1676		2083
1677	$class->SUPER::new (	2084	$class->SUPER::new (
1678	fg => [1, 1, 1],	2085	fg => [1, 1, 1],
1679	bg => [0, 0, 0, 0.2],	2086	bg => [0, 0, 0, 0.2],
		2087	outline => [0.6, 0.3, 0.1],
1680	active_bg => [1, 1, 1, 0.5],	2088	active_bg => [0, 0, 1, .2],
1681	active_fg => [0, 0, 0],	2089	active_fg => [1, 1, 1],
		2090	active_outline => [1, 1, 0],
1682	can_hover => 1,	2091	can_hover => 1,
1683	can_focus => 1,	2092	can_focus => 1,
1684	valign => 0,	2093	valign => 0,
1685	can_events => 1,	2094	can_events => 1,
		2095	ellipsise => 0,
1686	#text => ...	2096	#text => ...
		2097	#hidden => "*",
1687	@_	2098	@_
1688	)	2099	)
1689	}	2100	}
1690		2101
1691	sub _set_text {	2102	sub _set_text {
…		…
1698	$self->{last_activity} = $::NOW;	2109	$self->{last_activity} = $::NOW;
1699	$self->{text} = $text;	2110	$self->{text} = $text;
1700		2111
1701	$text =~ s/./*/g if $self->{hidden};	2112	$text =~ s/./*/g if $self->{hidden};
1702	$self->{layout}->set_text ("$text ");	2113	$self->{layout}->set_text ("$text ");
1703	delete $self->{req_h};	2114	delete $self->{size_req};
1704		2115
1705	$self->_emit (changed => $self->{text});	2116	$self->emit (changed => $self->{text});
1706		2117
1707	$self->realloc;	2118	$self->realloc;
1708	$self->update;	2119	$self->update;
1709	}	2120	}
1710		2121
…		…
1725	my ($w, $h) = $self->SUPER::size_request;	2136	my ($w, $h) = $self->SUPER::size_request;
1726		2137
1727	($w + 1, $h) # add 1 for cursor	2138	($w + 1, $h) # add 1 for cursor
1728	}	2139	}
1729		2140
1730	sub key_down {	2141	sub invoke_key_down {
1731	my ($self, $ev) = @_;	2142	my ($self, $ev) = @_;
1732		2143
1733	my $mod = $ev->{mod};	2144	my $mod = $ev->{mod};
1734	my $sym = $ev->{sym};	2145	my $sym = $ev->{sym};
1735	my $uni = $ev->{unicode};	2146	my $uni = $ev->{unicode};
1736		2147
1737	my $text = $self->get_text;	2148	my $text = $self->get_text;
		2149
		2150	$self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text;
1738		2151
1739	if ($uni == 8) {	2152	if ($uni == 8) {
1740	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	2153	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1741	} elsif ($uni == 127) {	2154	} elsif ($uni == 127) {
1742	substr $text, $self->{cursor}, 1, "";	2155	substr $text, $self->{cursor}, 1, "";
1743	} elsif ($sym == CFClient::SDLK_LEFT) {	2156	} elsif ($sym == CFPlus::SDLK_LEFT) {
1744	--$self->{cursor} if $self->{cursor};	2157	--$self->{cursor} if $self->{cursor};
1745	} elsif ($sym == CFClient::SDLK_RIGHT) {	2158	} elsif ($sym == CFPlus::SDLK_RIGHT) {
1746	++$self->{cursor} if $self->{cursor} < length $self->{text};	2159	++$self->{cursor} if $self->{cursor} < length $self->{text};
1747	} elsif ($sym == CFClient::SDLK_HOME) {	2160	} elsif ($sym == CFPlus::SDLK_HOME) {
		2161	# what a hack
		2162	$self->{cursor} =
		2163	(substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
		2164	? length $1
		2165	: 0;
		2166	} elsif ($sym == CFPlus::SDLK_END) {
		2167	# uh, again
		2168	$self->{cursor} =
		2169	(substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
		2170	? $self->{cursor} + length $1
		2171	: length $self->{text};
		2172	} elsif ($uni == 21) { # ctrl-u
		2173	$text = "";
1748	$self->{cursor} = 0;	2174	$self->{cursor} = 0;
1749	} elsif ($sym == CFClient::SDLK_END) {
1750	$self->{cursor} = length $text;
1751	} elsif ($uni == 27) {	2175	} elsif ($uni == 27) {
1752	$self->_emit ('escape');	2176	$self->emit ('escape');
1753	} elsif ($uni) {	2177	} elsif ($uni == 0x0d) {
		2178	substr $text, $self->{cursor}++, 0, "\012";
		2179	} elsif ($uni >= 0x20) {
1754	substr $text, $self->{cursor}++, 0, chr $uni;	2180	substr $text, $self->{cursor}++, 0, chr $uni;
1755	} else {	2181	} else {
1756	return 0;	2182	return 0;
1757	}	2183	}
1758		2184
1759	$self->_set_text ($text);	2185	$self->_set_text ($text);
1760		2186
1761	$self->realloc;	2187	$self->realloc;
		2188	$self->update;
1762		2189
1763	1	2190	1
1764	}	2191	}
1765		2192
1766	sub focus_in {	2193	sub invoke_focus_in {
1767	my ($self) = @_;	2194	my ($self) = @_;
1768		2195
1769	$self->{last_activity} = $::NOW;	2196	$self->{last_activity} = $::NOW;
1770		2197
1771	$self->SUPER::focus_in;	2198	$self->SUPER::invoke_focus_in
1772	}	2199	}
1773		2200
1774	sub button_down {	2201	sub invoke_button_down {
1775	my ($self, $ev, $x, $y) = @_;	2202	my ($self, $ev, $x, $y) = @_;
1776		2203
1777	$self->SUPER::button_down ($ev, $x, $y);	2204	$self->SUPER::invoke_button_down ($ev, $x, $y);
1778		2205
1779	my $idx = $self->{layout}->xy_to_index ($x, $y);	2206	my $idx = $self->{layout}->xy_to_index ($x, $y);
1780		2207
1781	# byte-index to char-index	2208	# byte-index to char-index
1782	my $text = $self->{text};	2209	my $text = $self->{text};
1783	utf8::encode $text;	2210	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1784	$self->{cursor} = length substr $text, 0, $idx;	2211	$self->{cursor} = length $text;
1785		2212
1786	$self->_set_text ($self->{text});	2213	$self->_set_text ($self->{text});
1787	$self->update;	2214	$self->update;
1788		2215
1789	1	2216	1
1790	}	2217	}
1791		2218
1792	sub mouse_motion {	2219	sub invoke_mouse_motion {
1793	my ($self, $ev, $x, $y) = @_;	2220	my ($self, $ev, $x, $y) = @_;
1794	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	2221	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1795		2222
1796	0	2223	1
1797	}	2224	}
1798		2225
1799	sub _draw {	2226	sub _draw {
1800	my ($self) = @_;	2227	my ($self) = @_;
1801		2228
…		…
1825		2252
1826	unless (exists $self->{cur_h}) {	2253	unless (exists $self->{cur_h}) {
1827	my $text = substr $self->{text}, 0, $self->{cursor};	2254	my $text = substr $self->{text}, 0, $self->{cursor};
1828	utf8::encode $text;	2255	utf8::encode $text;
1829		2256
1830	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)	2257	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
1831	}	2258	}
1832		2259
1833	glColor @{$self->{fg}};	2260	glColor_premultiply @{$self->{active_fg}};
1834	glBegin GL_LINES;	2261	glBegin GL_LINES;
1835	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};	2262	glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
1836	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};	2263	glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1837	glEnd;	2264	glEnd;
1838	}
1839	}
1840		2265
		2266	glLineWidth 3;
		2267	glColor @{$self->{active_outline}};
		2268	glBegin GL_LINE_LOOP;
		2269	glVertex 0, 0;
		2270	glVertex $self->{w} - 1, 0;
		2271	glVertex $self->{w} - 1, $self->{h} - 1;
		2272	glVertex 0, $self->{h} - 1;
		2273	glEnd;
		2274	glLineWidth 1;
		2275
		2276	} else {
		2277	glColor @{$self->{outline}};
		2278	glTranslate .375, .375;
		2279	glBegin GL_LINE_STRIP;
		2280	glVertex 0, $self->{h} * .5;
		2281	glVertex 0, $self->{h} - 3;
		2282	glVertex $self->{w} - 1, $self->{h} - 3;
		2283	glVertex $self->{w} - 1, $self->{h} * .5;
		2284	glEnd;
		2285	}
		2286	}
		2287
		2288	#############################################################################
		2289
1841	package CFClient::UI::Entry;	2290	package CFPlus::UI::Entry;
1842		2291
1843	our @ISA = CFClient::UI::EntryBase::;	2292	our @ISA = CFPlus::UI::EntryBase::;
1844		2293
1845	use CFClient::OpenGL;	2294	use CFPlus::OpenGL;
1846		2295
1847	sub key_down {	2296	sub invoke_key_down {
1848	my ($self, $ev) = @_;	2297	my ($self, $ev) = @_;
1849		2298
1850	my $sym = $ev->{sym};	2299	my $sym = $ev->{sym};
1851		2300
1852	if ($sym == 13) {	2301	if ($ev->{uni} == 0x0d || $sym == 13) {
1853	unshift @{$self->{history}},	2302	unshift @{$self->{history}},
1854	my $txt = $self->get_text;	2303	my $txt = $self->get_text;
		2304
1855	$self->{history_pointer} = -1;	2305	$self->{history_pointer} = -1;
1856	$self->{history_saveback} = '';	2306	$self->{history_saveback} = '';
1857	$self->_emit (activate => $txt);	2307	$self->emit (activate => $txt);
1858	$self->update;	2308	$self->update;
1859		2309
1860	} elsif ($sym == CFClient::SDLK_UP) {	2310	} elsif ($sym == CFPlus::SDLK_UP) {
1861	if ($self->{history_pointer} < 0) {	2311	if ($self->{history_pointer} < 0) {
1862	$self->{history_saveback} = $self->get_text;	2312	$self->{history_saveback} = $self->get_text;
1863	}	2313	}
1864	if (@{$self->{history} || []} > 0) {	2314	if (@{$self->{history} || []} > 0) {
1865	$self->{history_pointer}++;	2315	$self->{history_pointer}++;
…		…
1867	$self->{history_pointer} = @{$self->{history} || []} - 1;	2317	$self->{history_pointer} = @{$self->{history} || []} - 1;
1868	}	2318	}
1869	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2319	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1870	}	2320	}
1871		2321
1872	} elsif ($sym == CFClient::SDLK_DOWN) {	2322	} elsif ($sym == CFPlus::SDLK_DOWN) {
1873	$self->{history_pointer}--;	2323	$self->{history_pointer}--;
1874	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	2324	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1875		2325
1876	if ($self->{history_pointer} >= 0) {	2326	if ($self->{history_pointer} >= 0) {
1877	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2327	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1878	} else {	2328	} else {
1879	$self->set_text ($self->{history_saveback});	2329	$self->set_text ($self->{history_saveback});
1880	}	2330	}
1881		2331
1882	} else {	2332	} else {
1883	return $self->SUPER::key_down ($ev)	2333	return $self->SUPER::invoke_key_down ($ev)
1884	}	2334	}
1885		2335
1886	1	2336	1
1887	}	2337	}
1888		2338
1889	#############################################################################	2339	#############################################################################
1890		2340
		2341	package CFPlus::UI::TextEdit;
		2342
		2343	our @ISA = CFPlus::UI::EntryBase::;
		2344
		2345	use CFPlus::OpenGL;
		2346
		2347	sub move_cursor_ver {
		2348	my ($self, $dy) = @_;
		2349
		2350	my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
		2351
		2352	$y += $dy;
		2353
		2354	if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) {
		2355	$self->{cursor} = $index;
		2356	delete $self->{cur_h};
		2357	$self->update;
		2358	return;
		2359	}
		2360	}
		2361
		2362	sub invoke_key_down {
		2363	my ($self, $ev) = @_;
		2364
		2365	my $sym = $ev->{sym};
		2366
		2367	if ($sym == CFPlus::SDLK_UP) {
		2368	$self->move_cursor_ver (-1);
		2369	} elsif ($sym == CFPlus::SDLK_DOWN) {
		2370	$self->move_cursor_ver (+1);
		2371	} else {
		2372	return $self->SUPER::invoke_key_down ($ev)
		2373	}
		2374
		2375	1
		2376	}
		2377
		2378	#############################################################################
		2379
1891	package CFClient::UI::Button;	2380	package CFPlus::UI::ButtonBin;
1892		2381
1893	our @ISA = CFClient::UI::Label::;	2382	our @ISA = CFPlus::UI::Bin::;
1894		2383
1895	use CFClient::OpenGL;	2384	use CFPlus::OpenGL;
1896		2385
1897	my @tex =	2386	my @tex =
1898	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2387	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1899	qw(b1_button_active.png);	2388	qw(b1_button_inactive.png b1_button_active.png);
1900		2389
1901	sub new {	2390	sub new {
1902	my $class = shift;	2391	my $class = shift;
1903		2392
1904	$class->SUPER::new (	2393	$class->SUPER::new (
1905	padding_x => 4,
1906	padding_y => 4,
1907	fg => [1, 1, 1],
1908	active_fg => [0, 0, 1],
1909	can_hover => 1,	2394	can_hover => 1,
1910	align => 0,	2395	align => 0,
1911	valign => 0,	2396	valign => 0,
1912	can_events => 1,	2397	can_events => 1,
1913	@_	2398	@_
1914	)	2399	)
1915	}	2400	}
1916		2401
1917	sub activate { }
1918
1919	sub button_up {	2402	sub invoke_button_up {
1920	my ($self, $ev, $x, $y) = @_;	2403	my ($self, $ev, $x, $y) = @_;
1921		2404
1922	$self->emit ("activate")	2405	$self->emit ("activate")
1923	if $x >= 0 && $x < $self->{w}	2406	if $x >= 0 && $x < $self->{w}
1924	&& $y >= 0 && $y < $self->{h};	2407	&& $y >= 0 && $y < $self->{h};
…		…
1927	}	2410	}
1928		2411
1929	sub _draw {	2412	sub _draw {
1930	my ($self) = @_;	2413	my ($self) = @_;
1931		2414
1932	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1933
1934	glEnable GL_TEXTURE_2D;	2415	glEnable GL_TEXTURE_2D;
1935	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2416	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1936	glColor 0, 0, 0, 1;	2417	glColor 0, 0, 0, 1;
1937		2418
		2419	my $tex = $tex[$GRAB == $self];
1938	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2420	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1939		2421
1940	glDisable GL_TEXTURE_2D;	2422	glDisable GL_TEXTURE_2D;
1941		2423
1942	$self->SUPER::_draw;	2424	$self->SUPER::_draw;
1943	}	2425	}
1944		2426
1945	#############################################################################	2427	#############################################################################
1946		2428
1947	package CFClient::UI::CheckBox;	2429	package CFPlus::UI::Button;
1948		2430
1949	our @ISA = CFClient::UI::DrawBG::;	2431	our @ISA = CFPlus::UI::Label::;
		2432
		2433	use CFPlus::OpenGL;
1950		2434
1951	my @tex =	2435	my @tex =
1952	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2436	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
		2437	qw(b1_button_inactive.png b1_button_active.png);
		2438
		2439	sub new {
		2440	my $class = shift;
		2441
		2442	$class->SUPER::new (
		2443	padding_x => 4,
		2444	padding_y => 4,
		2445	fg => [1.0, 1.0, 1.0],
		2446	active_fg => [0.8, 0.8, 0.8],
		2447	can_hover => 1,
		2448	align => 0,
		2449	valign => 0,
		2450	can_events => 1,
		2451	@_
		2452	)
		2453	}
		2454
		2455	sub invoke_button_up {
		2456	my ($self, $ev, $x, $y) = @_;
		2457
		2458	$self->emit ("activate")
		2459	if $x >= 0 && $x < $self->{w}
		2460	&& $y >= 0 && $y < $self->{h};
		2461
		2462	1
		2463	}
		2464
		2465	sub _draw {
		2466	my ($self) = @_;
		2467
		2468	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
		2469
		2470	glEnable GL_TEXTURE_2D;
		2471	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2472	glColor 0, 0, 0, 1;
		2473
		2474	my $tex = $tex[$GRAB == $self];
		2475	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
		2476
		2477	glDisable GL_TEXTURE_2D;
		2478
		2479	$self->SUPER::_draw;
		2480	}
		2481
		2482	#############################################################################
		2483
		2484	package CFPlus::UI::CheckBox;
		2485
		2486	our @ISA = CFPlus::UI::DrawBG::;
		2487
		2488	my @tex =
		2489	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1953	qw(c1_checkbox_bg.png c1_checkbox_active.png);	2490	qw(c1_checkbox_bg.png c1_checkbox_active.png);
1954		2491
1955	use CFClient::OpenGL;	2492	use CFPlus::OpenGL;
1956		2493
1957	sub new {	2494	sub new {
1958	my $class = shift;	2495	my $class = shift;
1959		2496
1960	$class->SUPER::new (	2497	$class->SUPER::new (
…		…
1974	my ($self) = @_;	2511	my ($self) = @_;
1975		2512
1976	(6) x 2	2513	(6) x 2
1977	}	2514	}
1978		2515
		2516	sub toggle {
		2517	my ($self) = @_;
		2518
		2519	$self->{state} = !$self->{state};
		2520	$self->emit (changed => $self->{state});
		2521	$self->update;
		2522	}
		2523
1979	sub button_down {	2524	sub invoke_button_down {
1980	my ($self, $ev, $x, $y) = @_;	2525	my ($self, $ev, $x, $y) = @_;
1981		2526
1982	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2527	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1983	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2528	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1984	$self->{state} = !$self->{state};	2529	$self->toggle;
1985	$self->_emit (changed => $self->{state});
1986	} else {	2530	} else {
1987	return 0	2531	return 0
1988	}	2532	}
1989		2533
1990	1	2534	1
…		…
2010	glDisable GL_TEXTURE_2D;	2554	glDisable GL_TEXTURE_2D;
2011	}	2555	}
2012		2556
2013	#############################################################################	2557	#############################################################################
2014		2558
2015	package CFClient::UI::Image;	2559	package CFPlus::UI::Image;
2016		2560
2017	our @ISA = CFClient::UI::Base::;	2561	our @ISA = CFPlus::UI::Base::;
2018		2562
2019	use CFClient::OpenGL;	2563	use CFPlus::OpenGL;
2020	use Carp qw/confess/;
2021		2564
2022	our %loaded_images;	2565	our %texture_cache;
2023		2566
2024	sub new {	2567	sub new {
2025	my $class = shift;	2568	my $class = shift;
2026		2569
2027	my $self = $class->SUPER::new (can_events => 0, @_);	2570	my $self = $class->SUPER::new (
		2571	can_events => 0,
		2572	scale => 1,
		2573	@_,
		2574	);
2028		2575
2029	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2576	$self->{path} || $self->{tex}
		2577	or Carp::croak "'path' or 'tex' attributes required";
2030		2578
2031	$loaded_images{$self->{image}} ||=	2579	$self->{tex} ||= $texture_cache{$self->{path}} ||=
2032	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2580	new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
2033		2581
2034	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2582	CFPlus::weaken $texture_cache{$self->{path}};
2035		2583
2036	Scalar::Util::weaken $loaded_images{$self->{image}};	2584	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2037
2038	$self->{aspect} = $tex->{w} / $tex->{h};
2039		2585
2040	$self	2586	$self
2041	}	2587	}
2042		2588
		2589	sub STORABLE_freeze {
		2590	my ($self, $cloning) = @_;
		2591
		2592	$self->{path}
		2593	or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
		2594
		2595	$self->{path}
		2596	}
		2597
		2598	sub STORABLE_attach {
		2599	my ($self, $cloning, $path) = @_;
		2600
		2601	$self->new (path => $path)
		2602	}
		2603
2043	sub size_request {	2604	sub size_request {
2044	my ($self) = @_;	2605	my ($self) = @_;
2045		2606
2046	($self->{tex}->{w}, $self->{tex}->{h})	2607	(int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
2047	}	2608	}
2048		2609
2049	sub _draw {	2610	sub _draw {
2050	my ($self) = @_;	2611	my ($self) = @_;
2051		2612
…		…
2068	glDisable GL_TEXTURE_2D;	2629	glDisable GL_TEXTURE_2D;
2069	}	2630	}
2070		2631
2071	#############################################################################	2632	#############################################################################
2072		2633
		2634	package CFPlus::UI::ImageButton;
		2635
		2636	our @ISA = CFPlus::UI::Image::;
		2637
		2638	use CFPlus::OpenGL;
		2639
		2640	my %textures;
		2641
		2642	sub new {
		2643	my $class = shift;
		2644
		2645	my $self = $class->SUPER::new (
		2646	padding_x => 4,
		2647	padding_y => 4,
		2648	fg => [1, 1, 1],
		2649	active_fg => [0, 0, 1],
		2650	can_hover => 1,
		2651	align => 0,
		2652	valign => 0,
		2653	can_events => 1,
		2654	@_
		2655	);
		2656	}
		2657
		2658	sub invoke_button_down {
		2659	my ($self, $ev, $x, $y) = @_;
		2660
		2661	1
		2662	}
		2663
		2664	sub invoke_button_up {
		2665	my ($self, $ev, $x, $y) = @_;
		2666
		2667	$self->emit ("activate")
		2668	if $x >= 0 && $x < $self->{w}
		2669	&& $y >= 0 && $y < $self->{h};
		2670
		2671	1
		2672	}
		2673
		2674	#############################################################################
		2675
2073	package CFClient::UI::VGauge;	2676	package CFPlus::UI::VGauge;
2074		2677
2075	our @ISA = CFClient::UI::Base::;	2678	our @ISA = CFPlus::UI::Base::;
2076		2679
2077	use List::Util qw(min max);	2680	use List::Util qw(min max);
2078		2681
2079	use CFClient::OpenGL;	2682	use CFPlus::OpenGL;
2080		2683
2081	my %tex = (	2684	my %tex = (
2082	food => [	2685	food => [
2083	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2686	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2084	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2687	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2085	],	2688	],
2086	grace => [	2689	grace => [
2087	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2690	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2088	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/	2691	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2089	],	2692	],
2090	hp => [	2693	hp => [
2091	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2694	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2092	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2695	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2093	],	2696	],
2094	mana => [	2697	mana => [
2095	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2698	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2096	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/	2699	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2097	],	2700	],
2098	);	2701	);
2099		2702
2100	# eg. VGauge->new (gauge => 'food'), default gauge: food	2703	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2160	my $ycut1 = max 0, min 1, $ycut;	2763	my $ycut1 = max 0, min 1, $ycut;
2161	my $ycut2 = max 0, min 1, $ycut - 1;	2764	my $ycut2 = max 0, min 1, $ycut - 1;
2162		2765
2163	my $h1 = $self->{h} * (1 - $ycut1);	2766	my $h1 = $self->{h} * (1 - $ycut1);
2164	my $h2 = $self->{h} * (1 - $ycut2);	2767	my $h2 = $self->{h} * (1 - $ycut2);
		2768	my $h3 = $self->{h};
		2769
		2770	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2165		2771
2166	glEnable GL_BLEND;	2772	glEnable GL_BLEND;
2167	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2773	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2168	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2774	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2169	glEnable GL_TEXTURE_2D;	2775	glEnable GL_TEXTURE_2D;
…		…
2188		2794
2189	if ($t3) {	2795	if ($t3) {
2190	glBindTexture GL_TEXTURE_2D, $t3->{name};	2796	glBindTexture GL_TEXTURE_2D, $t3->{name};
2191	glBegin GL_QUADS;	2797	glBegin GL_QUADS;
2192	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2798	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2193	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2799	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2194	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2800	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2195	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2801	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2196	glEnd;	2802	glEnd;
2197	}	2803	}
2198		2804
2199	glDisable GL_BLEND;	2805	glDisable GL_BLEND;
2200	glDisable GL_TEXTURE_2D;	2806	glDisable GL_TEXTURE_2D;
2201	}	2807	}
2202		2808
2203	#############################################################################	2809	#############################################################################
2204		2810
2205	package CFClient::UI::Gauge;	2811	package CFPlus::UI::Gauge;
2206		2812
2207	our @ISA = CFClient::UI::VBox::;	2813	our @ISA = CFPlus::UI::VBox::;
2208		2814
2209	sub new {	2815	sub new {
2210	my ($class, %arg) = @_;	2816	my ($class, %arg) = @_;
2211		2817
2212	my $self = $class->SUPER::new (	2818	my $self = $class->SUPER::new (
…		…
2214	can_hover => 1,	2820	can_hover => 1,
2215	can_events => 1,	2821	can_events => 1,
2216	%arg,	2822	%arg,
2217	);	2823	);
2218		2824
2219	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2825	$self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999");
2220	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);	2826	$self->add ($self->{gauge} = new CFPlus::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
2221	$self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999");	2827	$self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2222		2828
2223	$self	2829	$self
2224	}	2830	}
2225		2831
2226	sub set_fontsize {	2832	sub set_fontsize {
…		…
2247	$self->{value}->set_text ($val);	2853	$self->{value}->set_text ($val);
2248	}	2854	}
2249		2855
2250	#############################################################################	2856	#############################################################################
2251		2857
2252	package CFClient::UI::Slider;	2858	package CFPlus::UI::Slider;
2253		2859
2254	use strict;	2860	use strict;
2255		2861
2256	use CFClient::OpenGL;	2862	use CFPlus::OpenGL;
2257		2863
2258	our @ISA = CFClient::UI::DrawBG::;	2864	our @ISA = CFPlus::UI::DrawBG::;
2259		2865
2260	my @tex =	2866	my @tex =
2261	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	2867	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2262	qw(s1_slider.png s1_slider_bg.png);	2868	qw(s1_slider.png s1_slider_bg.png);
2263		2869
2264	sub new {	2870	sub new {
2265	my $class = shift;	2871	my $class = shift;
2266		2872
…		…
2287	$self->update;	2893	$self->update;
2288		2894
2289	$self	2895	$self
2290	}	2896	}
2291		2897
2292	sub changed { }
2293
2294	sub set_range {	2898	sub set_range {
2295	my ($self, $range) = @_;	2899	my ($self, $range) = @_;
2296		2900
2297	($range, $self->{range}) = ($self->{range}, $range);	2901	($range, $self->{range}) = ($self->{range}, $range);
2298		2902
2299	$self->update
2300	if "@$range" ne "@{$self->{range}}";	2903	if ("@$range" ne "@{$self->{range}}") {
		2904	$self->update;
		2905	$self->set_value ($self->{range}[0]);
		2906	}
2301	}	2907	}
2302		2908
2303	sub set_value {	2909	sub set_value {
2304	my ($self, $value) = @_;	2910	my ($self, $value) = @_;
2305		2911
…		…
2316	if $unit;	2922	if $unit;
2317		2923
2318	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2924	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2319		2925
2320	if ($value != $old_value) {	2926	if ($value != $old_value) {
2321	$self->_emit (changed => $value);	2927	$self->emit (changed => $value);
2322	$self->update;	2928	$self->update;
2323	}	2929	}
2324	}	2930	}
2325		2931
2326	sub size_request {	2932	sub size_request {
2327	my ($self) = @_;	2933	my ($self) = @_;
2328		2934
2329	($self->{req_w}, $self->{req_h})	2935	($self->{req_w}, $self->{req_h})
2330	}	2936	}
2331		2937
2332	sub button_down {	2938	sub invoke_button_down {
2333	my ($self, $ev, $x, $y) = @_;	2939	my ($self, $ev, $x, $y) = @_;
2334		2940
2335	$self->SUPER::button_down ($ev, $x, $y);	2941	$self->SUPER::invoke_button_down ($ev, $x, $y);
2336		2942
2337	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2943	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2338		2944
2339	$self->mouse_motion ($ev, $x, $y)	2945	$self->invoke_mouse_motion ($ev, $x, $y);
2340	}
2341		2946
		2947	1
		2948	}
		2949
2342	sub mouse_motion {	2950	sub invoke_mouse_motion {
2343	my ($self, $ev, $x, $y) = @_;	2951	my ($self, $ev, $x, $y) = @_;
2344		2952
2345	if ($GRAB == $self) {	2953	if ($GRAB == $self) {
2346	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2954	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2347		2955
…		…
2351		2959
2352	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2960	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2353	} else {	2961	} else {
2354	return 0;	2962	return 0;
2355	}	2963	}
		2964
		2965	1
		2966	}
		2967
		2968	sub invoke_mouse_wheel {
		2969	my ($self, $ev) = @_;
		2970
		2971	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2972
		2973	my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2;
		2974
		2975	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
2356		2976
2357	1	2977	1
2358	}	2978	}
2359		2979
2360	sub update {	2980	sub update {
…		…
2411	glDisable GL_TEXTURE_2D;	3031	glDisable GL_TEXTURE_2D;
2412	}	3032	}
2413		3033
2414	#############################################################################	3034	#############################################################################
2415		3035
2416	package CFClient::UI::ValSlider;	3036	package CFPlus::UI::ValSlider;
2417		3037
2418	our @ISA = CFClient::UI::HBox::;	3038	our @ISA = CFPlus::UI::HBox::;
2419		3039
2420	sub new {	3040	sub new {
2421	my ($class, %arg) = @_;	3041	my ($class, %arg) = @_;
2422		3042
2423	my $range = delete $arg{range};	3043	my $range = delete $arg{range};
2424		3044
2425	my $self = $class->SUPER::new (	3045	my $self = $class->SUPER::new (
2426	slider => (new CFClient::UI::Slider expand => 1, range => $range),	3046	slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2427	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	3047	entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2428	to_value => sub { shift },	3048	to_value => sub { shift },
2429	from_value => sub { shift },	3049	from_value => sub { shift },
2430	%arg,	3050	%arg,
2431	);	3051	);
2432		3052
…		…
2452	sub set_range { shift->{slider}->set_range (@_) }	3072	sub set_range { shift->{slider}->set_range (@_) }
2453	sub set_value { shift->{slider}->set_value (@_) }	3073	sub set_value { shift->{slider}->set_value (@_) }
2454		3074
2455	#############################################################################	3075	#############################################################################
2456		3076
2457	package CFClient::UI::TextView;	3077	package CFPlus::UI::TextScroller;
2458		3078
2459	our @ISA = CFClient::UI::HBox::;	3079	our @ISA = CFPlus::UI::HBox::;
2460		3080
2461	use CFClient::OpenGL;	3081	use CFPlus::OpenGL;
2462		3082
2463	sub new {	3083	sub new {
2464	my $class = shift;	3084	my $class = shift;
2465		3085
2466	my $self = $class->SUPER::new (	3086	my $self = $class->SUPER::new (
2467	fontsize => 1,	3087	fontsize => 1,
2468	can_events => 0,	3088	can_events => 1,
		3089	indent => 0,
2469	#font => default_font	3090	#font => default_font
2470	@_,	3091	@_,
2471		3092
2472	layout => (new CFClient::Layout 1),	3093	layout => (new CFPlus::Layout),
2473	par => [],	3094	par => [],
		3095	max_par => 0,
2474	height => 0,	3096	height => 0,
2475	children => [	3097	children => [
2476	(new CFClient::UI::Empty expand => 1),	3098	(new CFPlus::UI::Empty expand => 1),
2477	(new CFClient::UI::Slider vertical => 1),	3099	(new CFPlus::UI::Slider vertical => 1),
2478	],	3100	],
2479	);	3101	);
2480		3102
2481	$self->{children}[1]->connect (changed => sub { $self->update });	3103	$self->{children}[1]->connect (changed => sub { $self->update });
2482		3104
…		…
2488		3110
2489	$self->{fontsize} = $fontsize;	3111	$self->{fontsize} = $fontsize;
2490	$self->reflow;	3112	$self->reflow;
2491	}	3113	}
2492		3114
		3115	sub size_request {
		3116	my ($self) = @_;
		3117
		3118	my ($empty, $slider) = $self->visible_children;
		3119
		3120	local $self->{children} = [$empty, $slider];
		3121	$self->SUPER::size_request
		3122	}
		3123
2493	sub size_allocate {	3124	sub invoke_size_allocate {
2494	my ($self, $w, $h) = @_;	3125	my ($self, $w, $h) = @_;
2495		3126
2496	$self->SUPER::size_allocate ($w, $h);	3127	my ($empty, $slider, @other) = @{ $self->{children} };
		3128	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2497		3129
2498	$self->{layout}->set_font ($self->{font}) if $self->{font};	3130	$self->{layout}->set_font ($self->{font}) if $self->{font};
2499	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	3131	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2500	$self->{layout}->set_width ($self->{children}[0]{w});	3132	$self->{layout}->set_width ($empty->{w});
		3133	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2501		3134
2502	$self->reflow;	3135	$self->reflow;
2503	}
2504		3136
2505	sub text_size {	3137	local $self->{children} = [$empty, $slider];
		3138	$self->SUPER::invoke_size_allocate ($w, $h)
		3139	}
		3140
		3141	sub invoke_mouse_wheel {
2506	my ($self, $text, $indent) = @_;	3142	my ($self, $ev) = @_;
		3143
		3144	return 0 unless $ev->{dy}; # only vertical movements
		3145
		3146	$self->{children}[1]->emit (mouse_wheel => $ev);
		3147
		3148	1
		3149	}
		3150
		3151	sub get_layout {
		3152	my ($self, $para) = @_;
2507		3153
2508	my $layout = $self->{layout};	3154	my $layout = $self->{layout};
2509		3155
		3156	$layout->set_font ($self->{font}) if $self->{font};
		3157	$layout->set_foreground (@{$para->{fg}});
2510	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	3158	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2511	$layout->set_width ($self->{children}[0]{w} - $indent);	3159	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
		3160	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2512	$layout->set_markup ($text);	3161	$layout->set_markup ($para->{markup});
		3162
		3163	$layout->set_shapes (
		3164	map
		3165	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		3166	@{$para->{widget}}
2513		3167	);
		3168
2514	$layout->size	3169	$layout
2515	}	3170	}
2516		3171
2517	sub reflow {	3172	sub reflow {
2518	my ($self) = @_;	3173	my ($self) = @_;
2519		3174
…		…
2526		3181
2527	# todo: base offset on lines or so, not on pixels	3182	# todo: base offset on lines or so, not on pixels
2528	$self->{children}[1]->set_value ($offset);	3183	$self->{children}[1]->set_value ($offset);
2529	}	3184	}
2530		3185
		3186	sub current_paragraph {
		3187	my ($self) = @_;
		3188
		3189	$self->{top_paragraph} - 1
		3190	}
		3191
		3192	sub scroll_to {
		3193	my ($self, $para) = @_;
		3194
		3195	$para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
		3196
		3197	$self->{scroll_to} = $para;
		3198	$self->update;
		3199	}
		3200
2531	sub clear {	3201	sub clear {
2532	my ($self) = @_;	3202	my ($self) = @_;
		3203
		3204	my (undef, undef, @other) = @{ $self->{children} };
		3205	$self->remove ($_) for @other;
2533		3206
2534	$self->{par} = [];	3207	$self->{par} = [];
2535	$self->{height} = 0;	3208	$self->{height} = 0;
2536	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	3209	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2537	}	3210	}
2538		3211
2539	sub add_paragraph {	3212	sub add_paragraph {
2540	my ($self, $color, $text, $indent) = @_;	3213	my $self = shift;
2541		3214
2542	for my $line (split /\n/, $text) {	3215	for my $para (@_) {
2543	my ($w, $h) = $self->text_size ($line);	3216	$para = {
		3217	fg => [1, 1, 1, 1],
		3218	indent => 0,
		3219	markup => "",
		3220	widget => [],
		3221	ref $para ? %$para : (markup => $para),
		3222	w => 1e10,
		3223	wrapped => 1,
		3224	};
		3225
		3226	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		3227	push @{$self->{par}}, $para;
		3228	}
		3229
		3230	if (my $max = $self->{max_par}) {
		3231	shift @{$self->{par}} while @{$self->{par}} > $max;
		3232	}
		3233
		3234	$self->{need_reflow}++;
		3235	$self->update;
		3236	}
		3237
		3238	sub scroll_to_bottom {
		3239	my ($self) = @_;
		3240
		3241	$self->{scroll_to} = $#{$self->{par}};
		3242	$self->update;
		3243	}
		3244
		3245	sub force_uptodate {
		3246	my ($self) = @_;
		3247
		3248	if (delete $self->{need_reflow}) {
		3249	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		3250
		3251	my $height = 0;
		3252
		3253	for my $para (@{$self->{par}}) {
		3254	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		3255	my $layout = $self->get_layout ($para);
		3256	my ($w, $h) = $layout->size;
		3257
		3258	$para->{w} = $w + $para->{indent};
		3259	$para->{h} = $h;
		3260	$para->{wrapped} = $layout->has_wrapped;
		3261	}
		3262
		3263	$para->{y} = $height;
		3264	$height += $para->{h};
		3265	}
		3266
2544	$self->{height} += $h;	3267	$self->{height} = $height;
2545	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	3268	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2546	}
2547		3269
2548	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	3270	delete $self->{texture};
		3271	}
		3272
		3273	if (my $paridx = delete $self->{scroll_to}) {
		3274	$self->{children}[1]->set_value ($self->{par}[$paridx]{y});
		3275	}
2549	}	3276	}
2550		3277
2551	sub update {	3278	sub update {
2552	my ($self) = @_;	3279	my ($self) = @_;
2553		3280
…		…
2555		3282
2556	return unless $self->{h} > 0;	3283	return unless $self->{h} > 0;
2557		3284
2558	delete $self->{texture};	3285	delete $self->{texture};
2559		3286
2560	$ROOT->on_post_alloc ($self, sub {	3287	$ROOT->on_post_alloc ($self => sub {
		3288	$self->force_uptodate;
		3289
2561	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3290	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2562		3291
2563	if (delete $self->{need_reflow}) {
2564	my $height = 0;
2565
2566	my $layout = $self->{layout};
2567
2568	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2569
2570	for (@{$self->{par}}) {
2571	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2572	$layout->set_width ($W - $_->[3]);
2573	$layout->set_markup ($_->[4]);
2574	my ($w, $h) = $layout->size;
2575	$_->[0] = $w + $_->[3];
2576	$_->[1] = $h;
2577	}
2578
2579	$height += $_->[1];
2580	}
2581
2582	$self->{height} = $height;
2583
2584	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2585
2586	delete $self->{texture};
2587	}
2588
2589	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	3292	$self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2590	glClearColor 0, 0, 0, 0;	3293	glClearColor 0, 0, 0, 0;
2591	glClear GL_COLOR_BUFFER_BIT;	3294	glClear GL_COLOR_BUFFER_BIT;
2592		3295
		3296	package CFPlus::UI::Base;
		3297	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		3298	(0, 0, $self->{w}, $self->{h});
		3299
		3300	my $top = int $self->{children}[1]{range}[0];
		3301
		3302	my $paridx = 0;
		3303	my $top_paragraph;
2593	my $top = int $self->{children}[1]{range}[0];	3304	my $top = int $self->{children}[1]{range}[0];
2594		3305
2595	my $y0 = $top;	3306	my $y0 = $top;
2596	my $y1 = $top + $H;	3307	my $y1 = $top + $H;
2597		3308
2598	my $y = 0;
2599
2600	my $layout = $self->{layout};
2601
2602	$layout->set_font ($self->{font}) if $self->{font};
2603
2604	glEnable GL_BLEND;
2605	#TODO# not correct in windows where rgba is forced off
2606	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2607
2608	for my $par (@{$self->{par}}) {	3309	for my $para (@{$self->{par}}) {
2609	my $h = $par->[1];	3310	my $h = $para->{h};
		3311	my $y = $para->{y};
2610		3312
2611	if ($y0 < $y + $h && $y < $y1) {	3313	if ($y0 < $y + $h && $y < $y1) {
2612	$layout->set_foreground (@{ $par->[2] });	3314	my $layout = $self->get_layout ($para);
2613	$layout->set_width ($W - $par->[3]);
2614	$layout->set_markup ($par->[4]);
2615		3315
2616	my ($w, $h, $data, $format, $internalformat) = $layout->render;	3316	$layout->render ($para->{indent}, $y - $y0);
		3317	$layout->draw;
2617		3318
2618	glRasterPos $par->[3], $y - $y0;	3319	if (my @w = @{ $para->{widget} }) {
2619	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	3320	my @s = $layout->get_shapes;
		3321
		3322	for (@w) {
		3323	my ($dx, $dy) = splice @s, 0, 2, ();
		3324
		3325	$_->{x} = $dx + $para->{indent};
		3326	$_->{y} = $dy + $y - $y0;
		3327
		3328	$_->draw;
		3329	}
		3330	}
2620	}	3331	}
2621		3332
2622	$y += $h;	3333	$paridx++;
		3334	$top_paragraph ||= $paridx if $y >= $top;
2623	}	3335	}
2624		3336
2625	glDisable GL_BLEND;	3337	$self->{top_paragraph} = $top_paragraph;
2626	};	3338	};
2627	});	3339	});
		3340	}
		3341
		3342	sub reconfigure {
		3343	my ($self) = @_;
		3344
		3345	$self->SUPER::reconfigure;
		3346
		3347	$_->{w} = 1e10 for @{ $self->{par} };
		3348	$self->reflow;
2628	}	3349	}
2629		3350
2630	sub _draw {	3351	sub _draw {
2631	my ($self) = @_;	3352	my ($self) = @_;
2632		3353
…		…
2635	glColor 0, 0, 0, 1;	3356	glColor 0, 0, 0, 1;
2636	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	3357	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2637	glDisable GL_TEXTURE_2D;	3358	glDisable GL_TEXTURE_2D;
2638		3359
2639	$self->{children}[1]->draw;	3360	$self->{children}[1]->draw;
2640
2641	}	3361	}
2642		3362
2643	#############################################################################	3363	#############################################################################
2644		3364
2645	package CFClient::UI::Animator;	3365	package CFPlus::UI::Animator;
2646		3366
2647	use CFClient::OpenGL;	3367	use CFPlus::OpenGL;
2648		3368
2649	our @ISA = CFClient::UI::Bin::;	3369	our @ISA = CFPlus::UI::Bin::;
2650		3370
2651	sub moveto {	3371	sub moveto {
2652	my ($self, $x, $y) = @_;	3372	my ($self, $x, $y) = @_;
2653		3373
2654	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3374	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2682	glPopMatrix;	3402	glPopMatrix;
2683	}	3403	}
2684		3404
2685	#############################################################################	3405	#############################################################################
2686		3406
2687	package CFClient::UI::Flopper;	3407	package CFPlus::UI::Flopper;
2688		3408
2689	our @ISA = CFClient::UI::Button::;	3409	our @ISA = CFPlus::UI::Button::;
2690		3410
2691	sub new {	3411	sub new {
2692	my $class = shift;	3412	my $class = shift;
2693		3413
2694	my $self = $class->SUPER::new (	3414	my $self = $class->SUPER::new (
…		…
2706	$self->{other}->toggle_visibility;	3426	$self->{other}->toggle_visibility;
2707	}	3427	}
2708		3428
2709	#############################################################################	3429	#############################################################################
2710		3430
2711	package CFClient::UI::Tooltip;	3431	package CFPlus::UI::Tooltip;
2712		3432
2713	our @ISA = CFClient::UI::Bin::;	3433	our @ISA = CFPlus::UI::Bin::;
2714		3434
2715	use CFClient::OpenGL;	3435	use CFPlus::OpenGL;
2716		3436
2717	sub new {	3437	sub new {
2718	my $class = shift;	3438	my $class = shift;
2719		3439
2720	$class->SUPER::new (	3440	$class->SUPER::new (
…		…
2723	)	3443	)
2724	}	3444	}
2725		3445
2726	sub set_tooltip_from {	3446	sub set_tooltip_from {
2727	my ($self, $widget) = @_;	3447	my ($self, $widget) = @_;
		3448
		3449	$widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
		3450	if $widget->{tooltip} =~ /^#(.*)$/;
2728		3451
2729	my $tooltip = $widget->{tooltip};	3452	my $tooltip = $widget->{tooltip};
2730		3453
2731	if ($ENV{CFPLUS_DEBUG} & 2) {	3454	if ($ENV{CFPLUS_DEBUG} & 2) {
2732	$tooltip .= "\n\n" . (ref $widget) . "\n"	3455	$tooltip .= "\n\n" . (ref $widget) . "\n"
2733	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	3456	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2734	. "req $widget->{req_w} $widget->{req_h}\n"	3457	. "req $widget->{req_w} $widget->{req_h}\n"
2735	. "visible $widget->{visible}";	3458	. "visible $widget->{visible}";
2736	}	3459	}
2737		3460
		3461	$tooltip =~ s/^\n+//;
		3462	$tooltip =~ s/\n+$//;
		3463
2738	$self->add (new CFClient::UI::Label	3464	$self->add (new CFPlus::UI::Label
2739	markup => $tooltip,	3465	markup => $tooltip,
2740	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3466	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2741	fontsize => 0.8,	3467	fontsize => 0.8,
2742	fg => [0, 0, 0, 1],	3468	style => 1, # FLAG_INVERSE
2743	ellipsise => 0,	3469	ellipsise => 0,
2744	font => ($widget->{tooltip_font} || $::FONT_PROP),	3470	font => ($widget->{tooltip_font} || $::FONT_PROP),
2745	);	3471	);
2746	}	3472	}
2747		3473
…		…
2751	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	3477	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2752		3478
2753	($w + 4, $h + 4)	3479	($w + 4, $h + 4)
2754	}	3480	}
2755		3481
2756	sub size_allocate {	3482	sub invoke_size_allocate {
2757	my ($self, $w, $h) = @_;	3483	my ($self, $w, $h) = @_;
2758		3484
2759	$self->SUPER::size_allocate ($w - 4, $h - 4);	3485	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2760	}	3486	}
2761		3487
2762	sub visibility_change {	3488	sub invoke_visibility_change {
2763	my ($self, $visible) = @_;	3489	my ($self, $visible) = @_;
2764		3490
2765	return unless $visible;	3491	return unless $visible;
2766		3492
2767	$self->{root}->on_post_alloc ("move_$self" => sub {	3493	$self->{root}->on_post_alloc ("move_$self" => sub {
2768	my $widget = $self->{owner}	3494	my $widget = $self->{owner}
2769	or return;	3495	or return;
2770		3496
		3497	if ($widget->{visible}) {
2771	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3498	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2772		3499
2773	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3500	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2774	if $x + $self->{w} > $::WIDTH;	3501	if $x + $self->{w} > $self->{root}{w};
2775		3502
2776	$self->move_abs ($x, $y);	3503	$self->move_abs ($x, $y);
		3504	} else {
		3505	$self->hide;
		3506	}
2777	});	3507	});
2778	}	3508	}
2779		3509
2780	sub _draw {	3510	sub _draw {
2781	my ($self) = @_;	3511	my ($self) = @_;
…		…
2783	glTranslate 0.375, 0.375;	3513	glTranslate 0.375, 0.375;
2784		3514
2785	my ($w, $h) = @$self{qw(w h)};	3515	my ($w, $h) = @$self{qw(w h)};
2786		3516
2787	glColor 1, 0.8, 0.4;	3517	glColor 1, 0.8, 0.4;
2788	glBegin GL_QUADS;	3518	glRect 0, 0, $w, $h;
2789	glVertex 0 , 0;
2790	glVertex 0 , $h;
2791	glVertex $w, $h;
2792	glVertex $w, 0;
2793	glEnd;
2794		3519
2795	glColor 0, 0, 0;	3520	glColor 0, 0, 0;
2796	glBegin GL_LINE_LOOP;	3521	glBegin GL_LINE_LOOP;
2797	glVertex 0 , 0;	3522	glVertex 0 , 0;
2798	glVertex 0 , $h;	3523	glVertex 0 , $h;
…		…
2805	$self->SUPER::_draw;	3530	$self->SUPER::_draw;
2806	}	3531	}
2807		3532
2808	#############################################################################	3533	#############################################################################
2809		3534
2810	package CFClient::UI::Face;	3535	package CFPlus::UI::Face;
2811		3536
2812	our @ISA = CFClient::UI::Base::;	3537	our @ISA = CFPlus::UI::DrawBG::;
2813		3538
2814	use CFClient::OpenGL;	3539	use CFPlus::OpenGL;
2815		3540
2816	sub new {	3541	sub new {
2817	my $class = shift;	3542	my $class = shift;
2818		3543
2819	my $self = $class->SUPER::new (	3544	my $self = $class->SUPER::new (
		3545	size_w => 32,
		3546	size_h => 8,
2820	aspect => 1,	3547	aspect => 1,
2821	can_events => 0,	3548	can_events => 0,
2822	@_,	3549	@_,
2823	);	3550	);
2824		3551
2825	if ($self->{anim} && $self->{animspeed}) {	3552	if ($self->{anim} && $self->{animspeed}) {
2826	Scalar::Util::weaken (my $widget = $self);	3553	CFPlus::weaken (my $widget = $self);
2827		3554
		3555	$widget->{animspeed} = List::Util::max 0.05, $widget->{animspeed};
		3556	$widget->{anim_start} = $self->{animspeed} * int Event::time / $self->{animspeed};
2828	$self->{timer} = Event->timer (	3557	$self->{timer} = Event->timer (
2829	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2830	hard => 1,	3558	parked => 1,
2831	interval => $self->{animspeed},
2832	cb => sub {	3559	cb => sub {
		3560	return unless $::CONN;
		3561
		3562	my $w = $widget
		3563	or return;
		3564
2833	++$widget->{frame};	3565	++$w->{frame};
		3566	$w->update_face;
		3567
		3568	# somehow, $widget can go away
2834	$widget->update;	3569	$w->update;
		3570	$w->update_timer;
2835	},	3571	},
2836	);	3572	);
		3573
		3574	$self->update_face;
		3575	$self->update_timer;
2837	}	3576	}
2838		3577
2839	$self	3578	$self
2840	}	3579	}
2841		3580
		3581	sub update_timer {
		3582	my ($self) = @_;
		3583
		3584	return unless $self->{timer};
		3585
		3586	if ($self->{visible}) {
		3587	$self->{timer}->at (
		3588	$self->{anim_start}
		3589	+ $self->{animspeed}
		3590	* int 1.5 + (Event::time - $self->{anim_start}) / $self->{animspeed}
		3591	);
		3592	$self->{timer}->start;
		3593	} else {
		3594	$self->{timer}->stop;
		3595	}
		3596	}
		3597
		3598	sub update_face {
		3599	my ($self) = @_;
		3600
		3601	return unless $::CONN;
		3602
		3603	if (my $anim = $::CONN->{anim}[$self->{anim}]) {
		3604	if ($anim && @$anim) {
		3605	delete $self->{wait_face};
		3606	$self->{face} = $anim->[ $self->{frame} % @$anim ];
		3607	if (my $tex = $self->{tex} = $::CONN->{texture}[ $::CONN->{faceid}[$self->{face}] ]) {
		3608	unless ($tex->{name} || $tex->{loading}) {
		3609	$tex->upload (sub { $self->reconfigure });
		3610	}
		3611	}
		3612	}
		3613	}
		3614	}
		3615
2842	sub size_request {	3616	sub size_request {
2843	(32, 8)	3617	my ($self) = @_;
		3618
		3619	if ($::CONN) {
		3620	if (my $faceid = $::CONN->{faceid}[$self->{face}]) {
		3621	if (my $tex = $self->{tex} = $::CONN->{texture}[$faceid]) {
		3622	if ($tex->{name}) {
		3623	return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
		3624	} elsif (!$tex->{loading}) {
		3625	$tex->upload (sub { $self->reconfigure });
		3626	}
		3627	} else {
		3628	$self->{wait_face} ||= $::CONN->connect_face_update ($faceid, sub {
		3629	$self->reconfigure;
		3630	});
		3631	}
		3632	}
		3633	}
		3634
		3635	($self->{size_w} || 8, $self->{size_h} || 8)
2844	}	3636	}
2845		3637
2846	sub update {	3638	sub update {
2847	my ($self) = @_;	3639	my ($self) = @_;
2848		3640
2849	return unless $self->{visible};	3641	return unless $self->{visible};
2850		3642
2851	$self->SUPER::update;	3643	$self->SUPER::update;
2852	}	3644	}
2853		3645
		3646	sub invoke_visibility_change {
		3647	my ($self) = @_;
		3648
		3649	$self->update_timer;
		3650
		3651	0
		3652	}
		3653
2854	sub _draw {	3654	sub _draw {
2855	my ($self) = @_;	3655	my ($self) = @_;
2856		3656
2857	return unless $::CONN;	3657	$self->SUPER::_draw;
2858		3658
2859	my $face;	3659	if (my $tex = $self->{tex}) {
2860
2861	if ($self->{frame}) {
2862	my $anim = $::CONN->{anim}[$self->{anim}];
2863
2864	$face = $anim->[ $self->{frame} % @$anim ]
2865	if $anim && @$anim;
2866	}
2867
2868	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2869
2870	if ($tex) {
2871	glEnable GL_TEXTURE_2D;	3660	glEnable GL_TEXTURE_2D;
2872	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3661	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2873	glColor 0, 0, 0, 1;	3662	glColor 0, 0, 0, 1;
2874	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3663	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2875	glDisable GL_TEXTURE_2D;	3664	glDisable GL_TEXTURE_2D;
2876	}	3665	}
2877	}	3666	}
2878		3667
2879	sub DESTROY {	3668	sub destroy {
2880	my ($self) = @_;	3669	my ($self) = @_;
2881		3670
2882	$self->{timer}->cancel	3671	(delete $self->{timer})->cancel
2883	if $self->{timer};	3672	if $self->{timer};
2884		3673
2885	$self->SUPER::DESTROY;	3674	$self->SUPER::destroy;
2886	}	3675	}
2887		3676
2888	#############################################################################	3677	#############################################################################
2889		3678
2890	package CFClient::UI::Buttonbar;	3679	package CFPlus::UI::Buttonbar;
2891		3680
2892	our @ISA = CFClient::UI::HBox::;	3681	our @ISA = CFPlus::UI::HBox::;
2893		3682
2894	# TODO: should actualyl wrap buttons and other goodies.	3683	# TODO: should actually wrap buttons and other goodies.
2895		3684
2896	#############################################################################	3685	#############################################################################
2897		3686
2898	package CFClient::UI::Menu;	3687	package CFPlus::UI::Menu;
2899		3688
2900	our @ISA = CFClient::UI::FancyFrame::;	3689	our @ISA = CFPlus::UI::Toplevel::;
2901		3690
2902	use CFClient::OpenGL;	3691	use CFPlus::OpenGL;
2903		3692
2904	sub new {	3693	sub new {
2905	my $class = shift;	3694	my $class = shift;
2906		3695
2907	my $self = $class->SUPER::new (	3696	my $self = $class->SUPER::new (
2908	items => [],	3697	items => [],
2909	z => 100,	3698	z => 100,
2910	@_,	3699	@_,
2911	);	3700	);
2912		3701
2913	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3702	$self->add ($self->{vbox} = new CFPlus::UI::VBox);
2914		3703
2915	for my $item (@{ $self->{items} }) {	3704	for my $item (@{ $self->{items} }) {
2916	my ($widget, $cb) = @$item;	3705	my ($widget, $cb, $tooltip) = @$item;
2917		3706
2918	# handle various types of items, only text for now	3707	# handle various types of items, only text for now
2919	if (!ref $widget) {	3708	if (!ref $widget) {
		3709	if ($widget =~ /\t/) {
		3710	my ($left, $right) = split /\t/, $widget, 2;
		3711
2920	$widget = new CFClient::UI::Label	3712	$widget = new CFPlus::UI::HBox
2921	can_hover => 1,	3713	can_hover => 1,
2922	can_events => 1,	3714	can_events => 1,
		3715	tooltip => $tooltip,
		3716	children => [
		3717	(new CFPlus::UI::Label markup => $left, expand => 1),
		3718	(new CFPlus::UI::Label markup => $right, align => +1),
		3719	],
		3720	;
		3721
		3722	} else {
		3723	$widget = new CFPlus::UI::Label
		3724	can_hover => 1,
		3725	can_events => 1,
2923	text => $widget;	3726	markup => $widget,
		3727	tooltip => $tooltip;
		3728	}
2924	}	3729	}
2925		3730
2926	$self->{item}{$widget} = $item;	3731	$self->{item}{$widget} = $item;
2927		3732
2928	$self->{vbox}->add ($widget);	3733	$self->{vbox}->add ($widget);
…		…
2933		3738
2934	# popup given the event (must be a mouse button down event currently)	3739	# popup given the event (must be a mouse button down event currently)
2935	sub popup {	3740	sub popup {
2936	my ($self, $ev) = @_;	3741	my ($self, $ev) = @_;
2937		3742
2938	$self->_emit ("popdown");	3743	$self->emit ("popdown");
2939		3744
2940	# maybe save $GRAB? must be careful about events...	3745	# maybe save $GRAB? must be careful about events...
2941	$GRAB = $self;	3746	$GRAB = $self;
2942	$self->{button} = $ev->{button};	3747	$self->{button} = $ev->{button};
2943		3748
2944	$self->show;	3749	$self->show;
2945	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3750	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2946	}	3751	}
2947		3752
2948	sub mouse_motion {	3753	sub invoke_mouse_motion {
2949	my ($self, $ev, $x, $y) = @_;	3754	my ($self, $ev, $x, $y) = @_;
2950		3755
2951	# TODO: should use vbox->find_widget or so	3756	# TODO: should use vbox->find_widget or so
2952	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3757	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2953	$self->{hover} = $self->{item}{$HOVER};	3758	$self->{hover} = $self->{item}{$HOVER};
2954		3759
2955	0	3760	0
2956	}	3761	}
2957		3762
2958	sub button_up {	3763	sub invoke_button_up {
2959	my ($self, $ev, $x, $y) = @_;	3764	my ($self, $ev, $x, $y) = @_;
2960		3765
2961	if ($ev->{button} == $self->{button}) {	3766	if ($ev->{button} == $self->{button}) {
2962	undef $GRAB;	3767	undef $GRAB;
2963	$self->hide;	3768	$self->hide;
2964		3769
2965	$self->_emit ("popdown");	3770	$self->emit ("popdown");
2966	$self->{hover}[1]->() if $self->{hover};	3771	$self->{hover}[1]->() if $self->{hover};
2967	} else {	3772	} else {
2968	return 0	3773	return 0
2969	}	3774	}
2970		3775
2971	1	3776	1
2972	}	3777	}
2973		3778
2974	#############################################################################	3779	#############################################################################
2975		3780
2976	package CFClient::UI::Multiplexer;	3781	package CFPlus::UI::Multiplexer;
2977		3782
2978	our @ISA = CFClient::UI::Container::;	3783	our @ISA = CFPlus::UI::Container::;
2979		3784
2980	sub new {	3785	sub new {
2981	my $class = shift;	3786	my $class = shift;
2982		3787
2983	my $self = $class->SUPER::new (	3788	my $self = $class->SUPER::new (
…		…
2997		3802
2998	$self->{current} = $self->{children}[0]	3803	$self->{current} = $self->{children}[0]
2999	if @{ $self->{children} };	3804	if @{ $self->{children} };
3000	}	3805	}
3001		3806
		3807	sub get_current_page {
		3808	my ($self) = @_;
		3809
		3810	$self->{current}
		3811	}
		3812
3002	sub set_current_page {	3813	sub set_current_page {
3003	my ($self, $page_or_widget) = @_;	3814	my ($self, $page_or_widget) = @_;
3004		3815
3005	my $widget = ref $page_or_widget	3816	my $widget = ref $page_or_widget
3006	? $page_or_widget	3817	? $page_or_widget
3007	: $self->{children}[$page_or_widget];	3818	: $self->{children}[$page_or_widget];
3008		3819
3009	$self->{current} = $widget;	3820	$self->{current} = $widget;
3010	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3821	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3011		3822
3012	$self->_emit (page_changed => $self->{current});	3823	$self->emit (page_changed => $self->{current});
3013		3824
3014	$self->realloc;	3825	$self->realloc;
3015	}	3826	}
3016		3827
3017	sub visible_children {	3828	sub visible_children {
…		…
3022	my ($self) = @_;	3833	my ($self) = @_;
3023		3834
3024	$self->{current}->size_request	3835	$self->{current}->size_request
3025	}	3836	}
3026		3837
3027	sub size_allocate {	3838	sub invoke_size_allocate {
3028	my ($self, $w, $h) = @_;	3839	my ($self, $w, $h) = @_;
3029		3840
3030	$self->{current}->configure (0, 0, $w, $h);	3841	$self->{current}->configure (0, 0, $w, $h);
		3842
		3843	1
3031	}	3844	}
3032		3845
3033	sub _draw {	3846	sub _draw {
3034	my ($self) = @_;	3847	my ($self) = @_;
3035		3848
3036	$self->{current}->draw;	3849	$self->{current}->draw;
3037	}	3850	}
3038		3851
3039	#############################################################################	3852	#############################################################################
3040		3853
3041	package CFClient::UI::Notebook;	3854	package CFPlus::UI::Notebook;
3042		3855
3043	our @ISA = CFClient::UI::VBox::;	3856	our @ISA = CFPlus::UI::VBox::;
3044		3857
3045	sub new {	3858	sub new {
3046	my $class = shift;	3859	my $class = shift;
3047		3860
3048	my $self = $class->SUPER::new (	3861	my $self = $class->SUPER::new (
3049	buttonbar => (new CFClient::UI::Buttonbar),	3862	buttonbar => (new CFPlus::UI::Buttonbar),
3050	multiplexer => (new CFClient::UI::Multiplexer expand => 1),	3863	multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
3051	# filter => # will be put between multiplexer and $self	3864	# filter => # will be put between multiplexer and $self
3052	@_,	3865	@_,
3053	);	3866	);
3054		3867
3055	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};	3868	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3056	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});	3869	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
3057		3870
		3871	{
		3872	Scalar::Util::weaken (my $wself = $self);
		3873
		3874	$self->{multiplexer}->connect (c_add => sub {
		3875	my ($mplex, $widgets) = @_;
		3876
		3877	for my $child (@$widgets) {
		3878	Scalar::Util::weaken $child;
		3879	$child->{c_tab_} ||= do {
		3880	my $tab =
		3881	(UNIVERSAL::isa $child->{c_tab}, "CFPlus::UI::Base")
		3882	? $child->{c_tab}
		3883	: new CFPlus::UI::Button markup => $child->{c_tab}[0], tooltip => $child->{c_tab}[1];
		3884
		3885	$tab->connect (activate => sub {
		3886	$wself->set_current_page ($child);
		3887	});
		3888
		3889	$tab
		3890	};
		3891
		3892	$self->{buttonbar}->add ($child->{c_tab_});
		3893	}
		3894	});
		3895
		3896	$self->{multiplexer}->connect (c_remove => sub {
		3897	my ($mplex, $widgets) = @_;
		3898
		3899	for my $child (@$widgets) {
		3900	$wself->{buttonbar}->remove ($child->{c_tab_});
		3901	}
		3902	});
		3903	}
		3904
3058	$self	3905	$self
3059	}	3906	}
3060		3907
3061	sub add {	3908	sub add {
		3909	my ($self, @widgets) = @_;
		3910
		3911	$self->{multiplexer}->add (@widgets)
		3912	}
		3913
		3914	sub remove {
		3915	my ($self, @widgets) = @_;
		3916
		3917	$self->{multiplexer}->remove (@widgets)
		3918	}
		3919
		3920	sub pages {
		3921	my ($self) = @_;
		3922	$self->{multiplexer}->children
		3923	}
		3924
		3925	sub add_tab {
3062	my ($self, $title, $widget, $tooltip) = @_;	3926	my ($self, $title, $widget, $tooltip) = @_;
3063		3927
3064	Scalar::Util::weaken $self;	3928	$title = [$title, $tooltip] unless ref $title;
		3929	$widget->{c_tab} = $title;
3065		3930
3066	$self->{buttonbar}->add (new CFClient::UI::Button
3067	markup => $title,
3068	tooltip => $tooltip,
3069	on_activate => sub { $self->set_current_page ($widget) },
3070	);
3071
3072	$self->{multiplexer}->add ($widget);	3931	$self->add ($widget);
		3932	}
		3933
		3934	sub get_current_page {
		3935	my ($self) = @_;
		3936
		3937	$self->{multiplexer}->get_current_page
3073	}	3938	}
3074		3939
3075	sub set_current_page {	3940	sub set_current_page {
3076	my ($self, $page) = @_;	3941	my ($self, $page) = @_;
3077		3942
3078	$self->{multiplexer}->set_current_page ($page);	3943	$self->{multiplexer}->set_current_page ($page);
3079	$self->_emit (page_changed => $self->{multiplexer}{current});	3944	$self->emit (page_changed => $self->{multiplexer}{current});
3080	}	3945	}
3081		3946
3082	#############################################################################	3947	#############################################################################
3083		3948
		3949	package CFPlus::UI::Selector;
		3950
		3951	use utf8;
		3952
		3953	our @ISA = CFPlus::UI::Button::;
		3954
		3955	sub new {
		3956	my $class = shift;
		3957
		3958	my $self = $class->SUPER::new (
		3959	options => [], # [value, title, longdesc], ...
		3960	value => undef,
		3961	@_,
		3962	);
		3963
		3964	$self->_set_value ($self->{value});
		3965
		3966	$self
		3967	}
		3968
		3969	sub invoke_button_down {
		3970	my ($self, $ev) = @_;
		3971
		3972	my @menu_items;
		3973
		3974	for (@{ $self->{options} }) {
		3975	my ($value, $title, $tooltip) = @$_;
		3976
		3977	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3978	}
		3979
		3980	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3981	}
		3982
		3983	sub _set_value {
		3984	my ($self, $value) = @_;
		3985
		3986	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3987	or return;
		3988
		3989	$self->{value} = $item->[0];
		3990	$self->set_markup ("$item->[1] ⇓");
		3991	$self->set_tooltip ($item->[2]);
		3992	}
		3993
		3994	sub set_value {
		3995	my ($self, $value) = @_;
		3996
		3997	return unless $self->{value} ne $value;
		3998
		3999	$self->_set_value ($value);
		4000	$self->emit (changed => $value);
		4001	}
		4002
		4003	#############################################################################
		4004
3084	package CFClient::UI::Statusbox;	4005	package CFPlus::UI::Statusbox;
3085		4006
3086	our @ISA = CFClient::UI::VBox::;	4007	our @ISA = CFPlus::UI::VBox::;
3087		4008
3088	sub new {	4009	sub new {
3089	my $class = shift;	4010	my $class = shift;
3090		4011
3091	my $self = $class->SUPER::new (	4012	my $self = $class->SUPER::new (
3092	fontsize => 0.8,	4013	fontsize => 0.8,
3093	@_,	4014	@_,
3094	);	4015	);
3095		4016
3096	Scalar::Util::weaken (my $this = $self);	4017	CFPlus::weaken (my $this = $self);
3097		4018
3098	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });	4019	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
3099		4020
3100	$self	4021	$self
3101	}	4022	}
…		…
3103	sub reorder {	4024	sub reorder {
3104	my ($self) = @_;	4025	my ($self) = @_;
3105	my $NOW = Time::HiRes::time;	4026	my $NOW = Time::HiRes::time;
3106		4027
3107	# freeze display when hovering over any label	4028	# freeze display when hovering over any label
3108	return if $CFClient::UI::TOOLTIP->{owner}	4029	return if $CFPlus::UI::TOOLTIP->{owner}
3109	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},	4030	&& grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
3110	values %{ $self->{item} };	4031	values %{ $self->{item} };
3111		4032
3112	while (my ($k, $v) = each %{ $self->{item} }) {	4033	while (my ($k, $v) = each %{ $self->{item} }) {
3113	delete $self->{item}{$k} if $v->{timeout} < $NOW;	4034	delete $self->{item}{$k} if $v->{timeout} < $NOW;
3114	}	4035	}
…		…
3135	for ($short) {	4056	for ($short) {
3136	s/^\s+//;	4057	s/^\s+//;
3137	s/\s+/ /g;	4058	s/\s+/ /g;
3138	}	4059	}
3139		4060
3140	new CFClient::UI::Label	4061	new CFPlus::UI::Label
3141	markup => $short,	4062	markup => $short,
3142	tooltip => $item->{tooltip},	4063	tooltip => $item->{tooltip},
3143	tooltip_font => $::FONT_PROP,	4064	tooltip_font => $::FONT_PROP,
3144	tooltip_width => 0.67,	4065	tooltip_width => 0.67,
3145	fontsize => $item->{fontsize} || $self->{fontsize},	4066	fontsize => $item->{fontsize} || $self->{fontsize},
…		…
3183	$item->{count}++;	4104	$item->{count}++;
3184	} else {	4105	} else {
3185	$item->{count} = 1;	4106	$item->{count} = 1;
3186	$item->{text} = $item->{tooltip} = $text;	4107	$item->{text} = $item->{tooltip} = $text;
3187	}	4108	}
3188	$item->{id} = ++$self->{id};	4109	$item->{id} += 0.2;#d#
3189	$item->{timeout} = $timeout;	4110	$item->{timeout} = $timeout;
3190	delete $item->{label};	4111	delete $item->{label};
3191	} else {	4112	} else {
3192	$self->{item}{$group} = {	4113	$self->{item}{$group} = {
3193	id => ++$self->{id},	4114	id => ++$self->{id},
…		…
3199	count => 1,	4120	count => 1,
3200	%arg,	4121	%arg,
3201	};	4122	};
3202	}	4123	}
3203		4124
		4125	$ROOT->on_refresh (reorder => sub {
3204	$self->reorder;	4126	$self->reorder;
		4127	});
3205	}	4128	}
3206		4129
3207	sub reconfigure {	4130	sub reconfigure {
3208	my ($self) = @_;	4131	my ($self) = @_;
3209		4132
…		…
3212		4135
3213	$self->reorder;	4136	$self->reorder;
3214	$self->SUPER::reconfigure;	4137	$self->SUPER::reconfigure;
3215	}	4138	}
3216		4139
3217	sub DESTROY {	4140	sub destroy {
3218	my ($self) = @_;	4141	my ($self) = @_;
3219		4142
3220	$self->{timer}->cancel;	4143	$self->{timer}->cancel;
3221		4144
3222	$self->SUPER::DESTROY;	4145	$self->SUPER::destroy;
3223	}	4146	}
3224		4147
3225	#############################################################################	4148	#############################################################################
3226		4149
3227	package CFClient::UI::Inventory;
3228
3229	our @ISA = CFClient::UI::ScrolledWindow::;
3230
3231	sub new {
3232	my $class = shift;
3233
3234	my $self = $class->SUPER::new (
3235	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3236	@_,
3237	);
3238
3239	$self
3240	}
3241
3242	sub set_items {
3243	my ($self, $items) = @_;
3244
3245	$self->{child}->clear;
3246	return unless $items;
3247
3248	my @items = sort {
3249	($a->{type} <=> $b->{type})
3250	or ($a->{name} cmp $b->{name})
3251	} @$items;
3252
3253	$self->{real_items} = \@items;
3254
3255	my $row = 0;
3256	for my $item (@items) {
3257	CFClient::Item::update_widgets $item;
3258
3259	$self->{child}->add (0, $row, $item->{face_widget});
3260	$self->{child}->add (1, $row, $item->{desc_widget});
3261	$self->{child}->add (2, $row, $item->{weight_widget});
3262
3263	$row++;
3264	}
3265	}
3266
3267	#############################################################################
3268
3269	package CFClient::UI::BindEditor;
3270
3271	our @ISA = CFClient::UI::FancyFrame::;
3272
3273	sub new {
3274	my $class = shift;
3275
3276	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3277
3278	$self->add (my $vb = new CFClient::UI::VBox);
3279
3280
3281	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3282	text => "start recording",
3283	tooltip => "Start/Stops recording of actions."
3284	."All subsequent actions after the recording started will be captured."
3285	."The actions are displayed after the record was stopped."
3286	."To bind the action you have to click on the 'Bind' button",
3287	on_activate => sub {
3288	unless ($self->{recording}) {
3289	$self->start;
3290	} else {
3291	$self->stop;
3292	}
3293	});
3294
3295	$vb->add (new CFClient::UI::Label text => "Actions:");
3296	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3297
3298	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3299	$vb->add (my $hb = new CFClient::UI::HBox);
3300	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3301	$hb->add (new CFClient::UI::Button
3302	text => "bind",
3303	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3304	on_activate => sub {
3305	$self->ask_for_bind;
3306	});
3307
3308	$vb->add (my $hb = new CFClient::UI::HBox);
3309	$hb->add (new CFClient::UI::Button
3310	text => "ok",
3311	expand => 1,
3312	tooltip => "This closes the binding editor and saves the binding",
3313	on_activate => sub {
3314	$self->hide;
3315	$self->commit;
3316	});
3317
3318	$hb->add (new CFClient::UI::Button
3319	text => "cancel",
3320	expand => 1,
3321	tooltip => "This closes the binding editor without saving",
3322	on_activate => sub {
3323	$self->hide;
3324	$self->{binding_cancel}->()
3325	if $self->{binding_cancel};
3326	});
3327
3328	$self->update_binding_widgets;
3329
3330	$self
3331	}
3332
3333	sub commit {
3334	my ($self) = @_;
3335	my ($mod, $sym, $cmds) = $self->get_binding;
3336	if ($sym != 0 && @$cmds > 0) {
3337	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3338	."'. Don't forget 'Save Config'!");
3339	$self->{binding_change}->($mod, $sym, $cmds)
3340	if $self->{binding_change};
3341	} else {
3342	$::STATUSBOX->add ("No action bound, no key or action specified!");
3343	$self->{binding_cancel}->()
3344	if $self->{binding_cancel};
3345	}
3346	}
3347
3348	sub start {
3349	my ($self) = @_;
3350
3351	$self->{rec_btn}->set_text ("stop recording");
3352	$self->{recording} = 1;
3353	$self->clear_command_list;
3354	$::CONN->start_record if $::CONN;
3355	}
3356
3357	sub stop {
3358	my ($self) = @_;
3359
3360	$self->{rec_btn}->set_text ("start recording");
3361	$self->{recording} = 0;
3362
3363	my $rec;
3364	$rec = $::CONN->stop_record if $::CONN;
3365	return unless ref $rec eq 'ARRAY';
3366	$self->set_command_list ($rec);
3367	}
3368
3369
3370	sub ask_for_bind_and_commit {
3371	my ($self) = @_;
3372	$self->ask_for_bind (1);
3373	}
3374
3375	sub ask_for_bind {
3376	my ($self, $commit) = @_;
3377
3378	CFClient::Binder::open_binding_dialog (sub {
3379	my ($mod, $sym) = @_;
3380	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3381	$self->update_binding_widgets;
3382	$self->commit if $commit;
3383	});
3384	}
3385
3386	# $mod and $sym are the modifiers and key symbol
3387	# $cmds is a array ref of strings (the commands)
3388	# $cb is the callback that is executed on OK
3389	# $ccb is the callback that is executed on CANCEL and
3390	# when the binding was unsuccessful on OK
3391	sub set_binding {
3392	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3393
3394	$self->clear_command_list;
3395	$self->{recording} = 0;
3396	$self->{rec_btn}->set_text ("start recording");
3397
3398	$self->{binding} = [$mod, $sym];
3399	$self->{commands} = $cmds;
3400
3401	$self->{binding_change} = $cb;
3402	$self->{binding_cancel} = $ccb;
3403
3404	$self->update_binding_widgets;
3405	}
3406
3407	# this is a shortcut method that asks for a binding
3408	# and then just binds it.
3409	sub do_quick_binding {
3410	my ($self, $cmds) = @_;
3411	$self->set_binding (undef, undef, $cmds, sub {
3412	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3413	});
3414	$self->ask_for_bind (1);
3415	}
3416
3417	sub update_binding_widgets {
3418	my ($self) = @_;
3419	my ($mod, $sym, $cmds) = $self->get_binding;
3420	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3421	$self->set_command_list ($cmds);
3422	}
3423
3424	sub get_binding {
3425	my ($self) = @_;
3426	return (
3427	$self->{binding}->[0],
3428	$self->{binding}->[1],
3429	[ grep { defined $_ } @{$self->{commands}} ]
3430	);
3431	}
3432
3433	sub clear_command_list {
3434	my ($self) = @_;
3435	$self->{cmdbox}->clear ();
3436	}
3437
3438	sub set_command_list {
3439	my ($self, $cmds) = @_;
3440
3441	$self->{cmdbox}->clear ();
3442	$self->{commands} = $cmds;
3443
3444	my $idx = 0;
3445
3446	for (@$cmds) {
3447	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3448
3449	my $i = $idx;
3450	$hb->add (new CFClient::UI::Label text => $_);
3451	$hb->add (new CFClient::UI::Button
3452	text => "delete",
3453	tooltip => "Deletes the action from the record",
3454	on_activate => sub {
3455	$self->{cmdbox}->remove ($hb);
3456	$cmds->[$i] = undef;
3457	});
3458
3459
3460	$idx++
3461	}
3462	}
3463
3464	#############################################################################
3465
3466	package CFClient::UI::SpellList;
3467
3468	our @ISA = CFClient::UI::Table::;
3469
3470	sub new {
3471	my $class = shift;
3472
3473	my $self = $class->SUPER::new (
3474	binding => [],
3475	commands => [],
3476	@_,
3477	)
3478	}
3479
3480	# XXX: Do sorting? Argl...
3481	sub add_spell {
3482	my ($self, $spell) = @_;
3483	$self->{spells}->{$spell->{name}} = $spell;
3484
3485	$self->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3486	face => $spell->{face},
3487	can_hover => 1,
3488	can_events => 1,
3489	tooltip => $spell->{message});
3490
3491	$self->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3492	text => $spell->{name},
3493	can_hover => 1,
3494	can_events => 1,
3495	tooltip => $spell->{message},
3496	expand => 1);
3497
3498	$self->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3499	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3500	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3501	expand => 1);
3502
3503	$self->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3504	text => "bind to key",
3505	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3506	}
3507
3508	sub rebuild_spell_list {
3509	my ($self) = @_;
3510	$self->{tbl_idx} = 0;
3511	$self->add_spell ($_) for values %{$self->{spells}};
3512	}
3513
3514	sub remove_spell {
3515	my ($self, $spell) = @_;
3516	delete $self->{spells}->{$spell->{name}};
3517	$self->rebuild_spell_list;
3518	}
3519
3520	#############################################################################
3521
3522	package CFClient::UI::Root;	4150	package CFPlus::UI::Root;
3523		4151
3524	our @ISA = CFClient::UI::Container::;	4152	our @ISA = CFPlus::UI::Container::;
3525		4153
3526	use List::Util qw(min max);	4154	use List::Util qw(min max);
3527		4155
3528	use CFClient::OpenGL;	4156	use CFPlus::OpenGL;
3529		4157
3530	sub new {	4158	sub new {
3531	my $class = shift;	4159	my $class = shift;
3532		4160
3533	my $self = $class->SUPER::new (	4161	my $self = $class->SUPER::new (
3534	visible => 1,	4162	visible => 1,
3535	@_,	4163	@_,
3536	);	4164	);
3537		4165
3538	Scalar::Util::weaken ($self->{root} = $self);	4166	CFPlus::weaken ($self->{root} = $self);
3539		4167
3540	$self	4168	$self
3541	}	4169	}
3542		4170
3543	sub size_request {	4171	sub size_request {
…		…
3558	$coord = $max - $size if $coord > $max - $size;	4186	$coord = $max - $size if $coord > $max - $size;
3559		4187
3560	int $coord + 0.5	4188	int $coord + 0.5
3561	}	4189	}
3562		4190
3563	sub size_allocate {	4191	sub invoke_size_allocate {
3564	my ($self, $w, $h) = @_;	4192	my ($self, $w, $h) = @_;
3565		4193
3566	for my $child ($self->children) {	4194	for my $child ($self->children) {
3567	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	4195	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3568		4196
…		…
3572	$X = _to_pixel $X, $W, $self->{w};	4200	$X = _to_pixel $X, $W, $self->{w};
3573	$Y = _to_pixel $Y, $H, $self->{h};	4201	$Y = _to_pixel $Y, $H, $self->{h};
3574		4202
3575	$child->configure ($X, $Y, $W, $H);	4203	$child->configure ($X, $Y, $W, $H);
3576	}	4204	}
		4205
		4206	1
3577	}	4207	}
3578		4208
3579	sub coord2local {	4209	sub coord2local {
3580	my ($self, $x, $y) = @_;	4210	my ($self, $x, $y) = @_;
3581		4211
…		…
3589	}	4219	}
3590		4220
3591	sub update {	4221	sub update {
3592	my ($self) = @_;	4222	my ($self) = @_;
3593		4223
3594	$::WANT_REFRESH++;	4224	$::WANT_REFRESH->start;
3595	}	4225	}
3596		4226
3597	sub add {	4227	sub add {
3598	my ($self, @children) = @_;	4228	my ($self, @children) = @_;
3599		4229
…		…
3636	while ($self->{refresh_hook}) {	4266	while ($self->{refresh_hook}) {
3637	$_->()	4267	$_->()
3638	for values %{delete $self->{refresh_hook}};	4268	for values %{delete $self->{refresh_hook}};
3639	}	4269	}
3640		4270
3641	if ($self->{realloc}) {	4271	while ($self->{realloc}) {
3642	my %queue;	4272	my %queue;
3643	my @queue;	4273	my @queue;
3644	my $widget;	4274	my $widget;
3645		4275
3646	outer:	4276	outer:
…		…
3693	}	4323	}
3694	}	4324	}
3695		4325
3696	delete $self->{realloc}{$widget+0};	4326	delete $self->{realloc}{$widget+0};
3697	}	4327	}
3698	}
3699		4328
3700	while (my $size_alloc = delete $self->{size_alloc}) {	4329	while (my $size_alloc = delete $self->{size_alloc}) {
3701	my @queue = sort { $b->{visible} <=> $a->{visible} }	4330	my @queue = sort { $a->{visible} <=> $b->{visible} }
3702	values %$size_alloc;	4331	values %$size_alloc;
3703		4332
3704	while () {	4333	while () {
3705	my $widget = pop @queue || last;	4334	my $widget = pop @queue || last;
3706		4335
3707	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	4336	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3708		4337
3709	$w = 0 if $w < 0;	4338	$w = max $widget->{min_w}, $w;
3710	$h = 0 if $h < 0;	4339	$h = max $widget->{min_h}, $h;
3711		4340
		4341	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		4342	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		4343
		4344	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		4345	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		4346
3712	$w = int $w + 0.5;	4347	$w = int $w + 0.5;
3713	$h = int $h + 0.5;	4348	$h = int $h + 0.5;
3714		4349
3715	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	4350	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3716	$widget->{old_w} = $widget->{w};	4351	$widget->{old_w} = $widget->{w};
3717	$widget->{old_h} = $widget->{h};	4352	$widget->{old_h} = $widget->{h};
3718		4353
3719	$widget->{w} = $w;	4354	$widget->{w} = $w;
3720	$widget->{h} = $h;	4355	$widget->{h} = $h;
3721		4356
3722	$widget->emit (size_allocate => $w, $h);	4357	$widget->emit (size_allocate => $w, $h);
		4358	}
3723	}	4359	}
3724	}	4360	}
3725	}	4361	}
3726		4362
3727	while ($self->{post_alloc_hook}) {	4363	while ($self->{post_alloc_hook}) {
3728	$_->()	4364	$_->()
3729	for values %{delete $self->{post_alloc_hook}};	4365	for values %{delete $self->{post_alloc_hook}};
3730	}	4366	}
3731
3732		4367
3733	glViewport 0, 0, $::WIDTH, $::HEIGHT;	4368	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3734	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	4369	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3735	glClear GL_COLOR_BUFFER_BIT;	4370	glClear GL_COLOR_BUFFER_BIT;
3736		4371
…		…
3739	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4374	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3740	glMatrixMode GL_MODELVIEW;	4375	glMatrixMode GL_MODELVIEW;
3741	glLoadIdentity;	4376	glLoadIdentity;
3742		4377
3743	{	4378	{
3744	package CFClient::UI::Base;	4379	package CFPlus::UI::Base;
3745		4380
3746	($draw_x, $draw_y, $draw_w, $draw_h) =	4381	local ($draw_x, $draw_y, $draw_w, $draw_h) =
3747	(0, 0, $self->{w}, $self->{h});	4382	(0, 0, $self->{w}, $self->{h});
3748	}
3749		4383
3750	$self->_draw;	4384	$self->_draw;
		4385	}
3751	}	4386	}
3752		4387
3753	#############################################################################	4388	#############################################################################
3754		4389
3755	package CFClient::UI;	4390	package CFPlus::UI;
3756		4391
3757	$ROOT = new CFClient::UI::Root;	4392	$ROOT = new CFPlus::UI::Root;
3758	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4393	$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
3759		4394
3760	1	4395	1
3761		4396

Diff Legend

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