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

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

Diff Legend

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