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

Diff Legend

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