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.288 by root, Mon Jun 5 21:14:40 2006 UTC vs.
Revision 1.410 by root, Sun Jul 22 16:37:19 2007 UTC

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

Diff Legend

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