ViewVC Help

View File | Revision Log | Show Annotations | Download File

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.284 by root, Mon Jun 5 03:06:04 2006 UTC vs.
Revision 1.411 by root, Sun Jul 22 19:34:59 2007 UTC

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

Diff Legend

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