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

Diff Legend

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