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

Diff Legend

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