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

Diff Legend

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