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.307 by root, Sun Jun 18 19:13:20 2006 UTC vs.
Revision 1.477 by root, Sun Jan 11 23:50:27 2009 UTC

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

Diff Legend

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