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

Diff Legend

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