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.311 by root, Fri Jun 23 22:35:16 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
…		…
345	my ($self, $x, $y, $w, $h) = @_;	402	my ($self, $x, $y, $w, $h) = @_;
346		403
347	if ($self->{aspect}) {	404	if ($self->{aspect}) {
348	my ($ow, $oh) = ($w, $h);	405	my ($ow, $oh) = ($w, $h);
349		406
350	$w = List::Util::min $w, int $h * $self->{aspect};	407	$w = List::Util::min $w, DC::ceil $h * $self->{aspect};
351	$h = List::Util::min $h, int $w / $self->{aspect};	408	$h = List::Util::min $h, DC::ceil $w / $self->{aspect};
352		409
353	# use alignment to adjust x, y	410	# use alignment to adjust x, y
354		411
355	$x += int 0.5 * ($ow - $w);	412	$x += int 0.5 * ($ow - $w);
356	$y += int 0.5 * ($oh - $h);	413	$y += int 0.5 * ($oh - $h);
…		…
397		454
398	return if $self->{tooltip} eq $tooltip;	455	return if $self->{tooltip} eq $tooltip;
399		456
400	$self->{tooltip} = $tooltip;	457	$self->{tooltip} = $tooltip;
401		458
402	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	459	if ($DC::UI::TOOLTIP->{owner} == $self) {
403	delete $CFClient::UI::TOOLTIP->{owner};	460	delete $DC::UI::TOOLTIP->{owner};
404	$CFClient::UI::TOOLTIP_WATCHER->cb->();	461	$DC::UI::TOOLTIP_WATCHER->invoke;
405	}	462	}
406	}	463	}
407		464
408	# translate global coordinates to local coordinate system	465	# translate global coordinates to local coordinate system
409	sub coord2local {	466	sub coord2local {
410	my ($self, $x, $y) = @_;	467	my ($self, $x, $y) = @_;
411		468
		469	return (undef, undef) unless $self->{parent};
		470
412	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})	471	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
413	}	472	}
414		473
415	# translate local coordinates to global coordinate system	474	# translate local coordinates to global coordinate system
416	sub coord2global {	475	sub coord2global {
417	my ($self, $x, $y) = @_;	476	my ($self, $x, $y) = @_;
418		477
		478	return (undef, undef) unless $self->{parent};
		479
419	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	480	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
420	}	481	}
421		482
422	sub invoke_focus_in {	483	sub invoke_focus_in {
423	my ($self) = @_;	484	my ($self) = @_;
424		485
425	return if $FOCUS == $self;	486	return if $FOCUS == $self;
426	return unless $self->{can_focus};	487	return unless $self->{can_focus};
427		488
428	my $focus = $FOCUS; $FOCUS = $self;	489	$FOCUS = $self;
429		490
430	$focus->update if $focus;	491	$self->update;
431	$FOCUS->update;
432		492
433	0	493	0
434	}	494	}
435		495
436	sub invoke_focus_out {	496	sub invoke_focus_out {
437	my ($self) = @_;	497	my ($self) = @_;
438		498
439	return unless $FOCUS == $self;	499	return unless $FOCUS == $self;
440		500
441	my $focus = $FOCUS; undef $FOCUS;	501	undef $FOCUS;
442		502
443	$focus->update if $focus; #?	503	$self->update;
444		504
445	$::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
446	unless $FOCUS;	506	unless $FOCUS;
447		507
448	0	508	0
449	}	509	}
450		510
451	sub grab_focus {	511	sub grab_focus {
452	my ($self) = @_;	512	my ($self) = @_;
453		513
		514	$FOCUS->emit ("focus_out") if $FOCUS;
454	$self->emit ("focus_in");	515	$self->emit ("focus_in");
455	}	516	}
456		517
457	sub invoke_mouse_motion { 1 }	518	sub invoke_mouse_motion { 0 }
458	sub invoke_button_up { 1 }	519	sub invoke_button_up { 0 }
459	sub invoke_key_down { 1 }	520	sub invoke_key_down { 0 }
460	sub invoke_key_up { 1 }	521	sub invoke_key_up { 0 }
		522	sub invoke_mouse_wheel { 0 }
461		523
462	sub invoke_button_down {	524	sub invoke_button_down {
463	my ($self, $ev, $x, $y) = @_;	525	my ($self, $ev, $x, $y) = @_;
464		526
465	$self->grab_focus;	527	$self->grab_focus;
466		528
467	1	529	0
468	}	530	}
469		531
470	sub connect {	532	sub connect {
471	my ($self, $signal, $cb) = @_;	533	my ($self, $signal, $cb) = @_;
472		534
473	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	}
474	}	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	);
475		555
476	sub emit {	556	sub emit {
477	my ($self, $signal, @args) = @_;	557	my ($self, $signal, @args) = @_;
478		558
479	#d##TODO# stop propagating at first true, do not use sum	559	# I do not really like this solution, but I do not like duplication
480	(List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before	560	# and needlessly verbose code, either.
		561	my @append
		562	= $has_coords{$signal}
		563	? $args[0]->xy ($self)
		564	: ();
		565
		566	#warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
		567
		568	for my $cb (
		569	@{$self->{signal_cb}{$signal} || []}, # before
481	|| ($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
482	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent	576	$self->{parent} && $self->{parent}->emit ($signal, @args)
483	}	577	}
484		578
485	sub find_widget {	579	#sub find_widget {
486	my ($self, $x, $y) = @_;	580	# in .xs
487
488	return () unless $self->{can_events};
489
490	return $self
491	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
492	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
493
494	()
495	}
496		581
497	sub set_parent {	582	sub set_parent {
498	my ($self, $parent) = @_;	583	my ($self, $parent) = @_;
499		584
500	Scalar::Util::weaken ($self->{parent} = $parent);	585	DC::weaken ($self->{parent} = $parent);
501	$self->set_visible if $parent->{visible};	586	$self->set_visible if $parent->{visible};
502	}	587	}
503		588
504	sub realloc {	589	sub realloc {
505	my ($self) = @_;	590	my ($self) = @_;
…		…
531		616
532	# 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
533	# functions seems pointless.	618	# functions seems pointless.
534	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
535		620
536	sub draw {	621	#sub draw {
537	my ($self) = @_;	622	#CFPlus.xs
538
539	return unless $self->{h} && $self->{w};
540
541	# update screen rectangle
542	local $draw_x = $draw_x + $self->{x};
543	local $draw_y = $draw_y + $self->{y};
544	local $draw_w = $draw_x + $self->{w};
545	local $draw_h = $draw_y + $self->{h};
546
547	# skip widgets that are entirely outside the drawing area
548	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
549	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
550
551	glPushMatrix;
552	glTranslate $self->{x}, $self->{y}, 0;
553
554	if ($self == $HOVER && $self->{can_hover}) {
555	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
556	glEnable GL_BLEND;
557	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
558	glBegin GL_QUADS;
559	glVertex 0 , 0;
560	glVertex $self->{w}, 0;
561	glVertex $self->{w}, $self->{h};
562	glVertex 0 , $self->{h};
563	glEnd;
564	glDisable GL_BLEND;
565	}
566
567	if ($ENV{CFPLUS_DEBUG} & 1) {
568	glPushMatrix;
569	glColor 1, 1, 0, 1;
570	glTranslate 0.375, 0.375;
571	glBegin GL_LINE_LOOP;
572	glVertex 0 , 0;
573	glVertex $self->{w} - 1, 0;
574	glVertex $self->{w} - 1, $self->{h} - 1;
575	glVertex 0 , $self->{h} - 1;
576	glEnd;
577	glPopMatrix;
578	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
579	}
580
581	$self->_draw;
582	glPopMatrix;
583	}
584		623
585	sub _draw {	624	sub _draw {
586	my ($self) = @_;	625	my ($self) = @_;
587		626
588	warn "no draw defined for $self\n";	627	warn "no draw defined for $self\n";
589	}	628	}
590		629
591	sub DESTROY {	630	sub DESTROY {
592	my ($self) = @_;	631	my ($self) = @_;
593		632
594	delete $WIDGET{$self+0};	633	return if DC::in_destruct;
595		634
		635	local $@;
596	eval { $self->destroy };	636	eval { $self->destroy };
597	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};
598	}	640	}
599		641
600	#############################################################################	642	#############################################################################
601		643
602	package CFClient::UI::DrawBG;	644	package DC::UI::DrawBG;
603		645
604	our @ISA = CFClient::UI::Base::;	646	our @ISA = DC::UI::Base::;
605		647
606	use strict;	648	use strict;
607	use CFClient::OpenGL;	649	use DC::OpenGL;
608		650
609	sub new {	651	sub new {
610	my $class = shift;	652	my $class = shift;
611
612	# range [value, low, high, page]
613		653
614	$class->SUPER::new (	654	$class->SUPER::new (
615	#bg => [0, 0, 0, 0.2],	655	#bg => [0, 0, 0, 0.2],
616	#active_bg => [1, 1, 1, 0.5],	656	#active_bg => [1, 1, 1, 0.5],
617	@_	657	@_
618	)	658	)
619	}	659	}
620		660
		661	sub set_bg {
		662	my ($self, $bg) = @_;
		663
		664	$self->{bg} = $bg;
		665	$self->update;
		666	}
		667
621	sub _draw {	668	sub _draw {
622	my ($self) = @_;	669	my ($self) = @_;
623		670
624	my $color = $FOCUS == $self && $self->{active_bg}	671	my $color = $FOCUS == $self && $self->{active_bg}
625	? $self->{active_bg}	672	? $self->{active_bg}
…		…
629	my ($w, $h) = @$self{qw(w h)};	676	my ($w, $h) = @$self{qw(w h)};
630		677
631	glEnable GL_BLEND;	678	glEnable GL_BLEND;
632	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	679	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
633	glColor_premultiply @$color;	680	glColor_premultiply @$color;
634
635	glBegin GL_QUADS;
636	glVertex 0 , 0;
637	glVertex 0 , $h;
638	glVertex $w, $h;	681	glRect 0, 0, $w, $h;
639	glVertex $w, 0;
640	glEnd;
641
642	glDisable GL_BLEND;	682	glDisable GL_BLEND;
643	}	683	}
644	}	684	}
645		685
646	#############################################################################	686	#############################################################################
647		687
648	package CFClient::UI::Empty;	688	package DC::UI::Empty;
649		689
650	our @ISA = CFClient::UI::Base::;	690	our @ISA = DC::UI::Base::;
651		691
652	sub new {	692	sub new {
653	my ($class, %arg) = @_;	693	my ($class, %arg) = @_;
654	$class->SUPER::new (can_events => 0, %arg);	694	$class->SUPER::new (can_events => 0, %arg);
655	}	695	}
…		…
662		702
663	sub draw { }	703	sub draw { }
664		704
665	#############################################################################	705	#############################################################################
666		706
667	package CFClient::UI::Container;	707	package DC::UI::Container;
668		708
669	our @ISA = CFClient::UI::Base::;	709	our @ISA = DC::UI::Base::;
670		710
671	sub new {	711	sub new {
672	my ($class, %arg) = @_;	712	my ($class, %arg) = @_;
673		713
674	my $children = delete $arg{children};	714	my $children = delete $arg{children};
…		…
678	can_events => 0,	718	can_events => 0,
679	%arg,	719	%arg,
680	);	720	);
681		721
682	$self->add (@$children)	722	$self->add (@$children)
683	if $children;	723	if $children && @$children;
684		724
685	$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;
686	}	734	}
687		735
688	sub add {	736	sub add {
689	my ($self, @widgets) = @_;	737	my ($self, @widgets) = @_;
690		738
691	$_->set_parent ($self)	739	$_->set_parent ($self)
692	for @widgets;	740	for @widgets;
693		741
		742	# TODO: only do this in widgets that need it, e.g. root, fixed
694	use sort 'stable';	743	use sort 'stable';
695		744
696	$self->{children} = [	745	$self->{children} = [
697	sort { $a->{z} <=> $b->{z} }	746	sort { $a->{z} <=> $b->{z} }
698	@{$self->{children}}, @widgets	747	@{$self->{children}}, @widgets
699	];	748	];
700		749
701	$self->realloc;	750	$self->realloc;
		751
		752	$self->emit (c_add => \@widgets);
		753
		754	map $_+0, @widgets
702	}	755	}
703		756
704	sub children {	757	sub children {
705	@{ $_[0]{children} }	758	@{ $_[0]{children} }
706	}	759	}
707		760
708	sub remove {	761	sub remove {
709	my ($self, $child) = @_;	762	my ($self, @widgets) = @_;
710		763
		764	$self->emit (c_remove => \@widgets);
		765
		766	for my $child (@widgets) {
711	delete $child->{parent};	767	delete $child->{parent};
712	$child->hide;	768	$child->hide;
713
714	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	769	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
		770	}
715		771
716	$self->realloc;	772	$self->realloc;
717	}	773	}
718		774
719	sub clear {	775	sub clear {
720	my ($self) = @_;	776	my ($self) = @_;
721		777
722	my $children = delete $self->{children};	778	my $children = $self->{children};
723	$self->{children} = [];	779	$self->{children} = [];
724		780
725	for (@$children) {	781	for (@$children) {
726	delete $_->{parent};	782	delete $_->{parent};
727	$_->hide;	783	$_->hide;
…		…
747	}	803	}
748		804
749	sub _draw {	805	sub _draw {
750	my ($self) = @_;	806	my ($self) = @_;
751		807
752	$_->draw for @{$self->{children}};	808	$_->draw for $self->visible_children;
753	}	809	}
754		810
755	#############################################################################	811	#############################################################################
756		812
757	package CFClient::UI::Bin;	813	package DC::UI::Bin;
758		814
759	our @ISA = CFClient::UI::Container::;	815	our @ISA = DC::UI::Container::;
760		816
761	sub new {	817	sub new {
762	my ($class, %arg) = @_;	818	my ($class, %arg) = @_;
763		819
764	my $child = (delete $arg{child}) || new CFClient::UI::Empty::;	820	my $child = (delete $arg{child}) || new DC::UI::Empty::;
765		821
766	$class->SUPER::new (children => [$child], %arg)	822	$class->SUPER::new (children => [$child], %arg)
767	}	823	}
768		824
769	sub add {	825	sub add {
770	my ($self, $child) = @_;	826	my ($self, $child) = @_;
771		827
772	$self->SUPER::remove ($_) for @{ $self->{children} };	828	$self->clear;
773	$self->SUPER::add ($child);	829	$self->SUPER::add ($child);
774	}	830	}
775		831
776	sub remove {	832	sub remove {
777	my ($self, $widget) = @_;	833	my ($self, $widget) = @_;
778		834
779	$self->SUPER::remove ($widget);	835	$self->SUPER::remove ($widget);
780		836
781	$self->{children} = [new CFClient::UI::Empty]	837	$self->{children} = [new DC::UI::Empty]
782	unless @{$self->{children}};	838	unless @{$self->{children}};
783	}	839	}
784		840
785	sub child { $_[0]->{children}[0] }	841	sub child { $_[0]->{children}[0] }
786		842
…		…
795		851
796	1	852	1
797	}	853	}
798		854
799	#############################################################################	855	#############################################################################
800
801	# back-buffered drawing area	856	# back-buffered drawing area
802		857
803	package CFClient::UI::Window;	858	package DC::UI::Window;
804		859
805	our @ISA = CFClient::UI::Bin::;	860	our @ISA = DC::UI::Bin::;
806		861
807	use CFClient::OpenGL;	862	use DC::OpenGL;
808		863
809	sub new {	864	sub new {
810	my ($class, %arg) = @_;	865	my ($class, %arg) = @_;
811		866
812	my $self = $class->SUPER::new (%arg);	867	my $self = $class->SUPER::new (%arg);
…		…
834	}	889	}
835		890
836	sub render_child {	891	sub render_child {
837	my ($self) = @_;	892	my ($self) = @_;
838		893
839	$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 {
840	glClearColor 0, 0, 0, 0;	895	glClearColor 0, 0, 0, 0;
841	glClear GL_COLOR_BUFFER_BIT;	896	glClear GL_COLOR_BUFFER_BIT;
842		897
843	{	898	{
844	package CFClient::UI::Base;	899	package DC::UI::Base;
845		900
846	($draw_x, $draw_y, $draw_w, $draw_h) =	901	local ($draw_x, $draw_y, $draw_w, $draw_h) =
847	(0, 0, $self->{w}, $self->{h});	902	(0, 0, $self->{w}, $self->{h});
		903
		904	$self->_render;
848	}	905	}
849
850	$self->_render;
851	};	906	};
852	}	907	}
853		908
854	sub _draw {	909	sub _draw {
855	my ($self) = @_;	910	my ($self) = @_;
856
857	my ($w, $h) = @$self{qw(w h)};
858		911
859	my $tex = $self->{texture}	912	my $tex = $self->{texture}
860	or return;	913	or return;
861		914
862	glEnable GL_TEXTURE_2D;	915	glEnable GL_TEXTURE_2D;
863	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	916	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
864	glColor 0, 0, 0, 1;	917	glColor 0, 0, 0, 1;
865		918
866	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	919	$tex->draw_quad_alpha_premultiplied (0, 0);
867		920
868	glDisable GL_TEXTURE_2D;	921	glDisable GL_TEXTURE_2D;
869	}	922	}
870		923
871	#############################################################################	924	#############################################################################
872		925
873	package CFClient::UI::ViewPort;	926	package DC::UI::ViewPort;
874		927
		928	use List::Util qw(min max);
		929
875	our @ISA = CFClient::UI::Window::;	930	our @ISA = DC::UI::Window::;
876		931
877	sub new {	932	sub new {
878	my $class = shift;	933	my $class = shift;
879		934
880	$class->SUPER::new (	935	$class->SUPER::new (
…		…
887	sub size_request {	942	sub size_request {
888	my ($self) = @_;	943	my ($self) = @_;
889		944
890	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	945	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
891		946
892	$w = 10 if $self->{scroll_x};	947	$w = 1 if $self->{scroll_x};
893	$h = 10 if $self->{scroll_y};	948	$h = 1 if $self->{scroll_y};
894		949
895	($w, $h)	950	($w, $h)
896	}	951	}
897		952
898	sub invoke_size_allocate {	953	sub invoke_size_allocate {
…		…
910	}	965	}
911		966
912	sub set_offset {	967	sub set_offset {
913	my ($self, $x, $y) = @_;	968	my ($self, $x, $y) = @_;
914		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}) {
915	$self->{view_x} = int $x;	974	$self->{view_x} = $x;
916	$self->{view_y} = int $y;	975	$self->{view_y} = $y;
917		976
		977	$self->emit (changed => $x, $y);
918	$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	}
919	}	998	}
920		999
921	# 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
922	sub coord2local {	1001	sub coord2local {
923	my ($self, $x, $y) = @_;	1002	my ($self, $x, $y) = @_;
…		…
938	my ($self, $x, $y) = @_;	1017	my ($self, $x, $y) = @_;
939		1018
940	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}	1019	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
941	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}	1020	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
942	) {	1021	) {
943	$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})
944	} else {	1023	} else {
945	$self->CFClient::UI::Base::find_widget ($x, $y)	1024	$self->DC::UI::Base::find_widget ($x, $y)
946	}	1025	}
947	}	1026	}
948		1027
949	sub _render {	1028	sub _render {
950	my ($self) = @_;	1029	my ($self) = @_;
951		1030
952	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};
953	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};
954		1033
955	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	1034	DC::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
956		1035
957	$self->SUPER::_render;	1036	$self->SUPER::_render;
958	}	1037	}
959		1038
960	#############################################################################	1039	#############################################################################
961		1040
962	package CFClient::UI::ScrolledWindow;	1041	package DC::UI::ScrolledWindow;
963		1042
964	our @ISA = CFClient::UI::HBox::;	1043	our @ISA = DC::UI::Table::;
965		1044
966	sub new {	1045	sub new {
967	my ($class, %arg) = @_;	1046	my ($class, %arg) = @_;
968		1047
969	my $child = delete $arg{child};	1048	my $child = delete $arg{child};
970		1049
971	my $self;	1050	my $self;
972		1051
973	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,
974	vertical => 1,	1066	vertical => 1,
975	range => [0, 0, 1, 0.01], # HACK fix	1067	range => [0, 0, 1, 0.01], # HACK fix
976	on_changed => sub {	1068	on_changed => sub {
977	$self->{vp}->set_offset (0, $_[1]);	1069	$self->{vpos} = $_[1];
		1070	$self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
978	},	1071	},
979	;	1072	;
980		1073
981	$self = $class->SUPER::new (	1074	$self = $class->SUPER::new (
982	vp => (new CFClient::UI::ViewPort expand => 1),	1075	scroll_x => 0,
		1076	scroll_y => 1,
		1077	can_events => 1,
983	slider => $slider,	1078	hslider => $hslider,
		1079	vslider => $vslider,
		1080	col_expand => [1, 0],
		1081	row_expand => [1, 0],
984	%arg,	1082	%arg,
985	);	1083	);
986		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
987	$self->SUPER::add ($self->{vp}, $self->{slider});	1106	$self->SUPER::add ($self->{vp});
		1107
988	$self->add ($child) if $child;	1108	$self->add ($child) if $child;
989		1109
990	$self	1110	$self
991	}	1111	}
992		1112
…		…
994	my ($self, $widget) = @_;	1114	my ($self, $widget) = @_;
995		1115
996	$self->{vp}->add ($self->{child} = $widget);	1116	$self->{vp}->add ($self->{child} = $widget);
997	}	1117	}
998		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
999	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 {
1000	my ($self) = @_;	1154	my ($self, $ev) = @_;
1001		1155
1002	$self->SUPER::update;	1156	$self->grab_focus;
1003		1157
1004	# todo: overwrite size_allocate of child	1158	my $ox = $self->{vp}{view_x};
1005	my $child = $self->{vp}->child;	1159	my $oy = $self->{vp}{view_y};
1006	$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
1007	}	1210	}
1008		1211
1009	sub invoke_size_allocate {	1212	sub invoke_size_allocate {
1010	my ($self, $w, $h) = @_;	1213	my ($self, $w, $h) = @_;
1011		1214
1012	my $child = $self->{vp}->child;	1215	$self->update_slider;
1013	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1014
1015	$self->SUPER::invoke_size_allocate ($w, $h)	1216	$self->SUPER::invoke_size_allocate ($w, $h)
1016	}	1217	}
1017		1218
1018	#TODO# update range on size_allocate depending on child
1019	# update viewport offset on scroll
1020
1021	#############################################################################	1219	#############################################################################
1022		1220
1023	package CFClient::UI::Frame;	1221	package DC::UI::Frame;
1024		1222
1025	our @ISA = CFClient::UI::Bin::;	1223	our @ISA = DC::UI::Bin::;
1026		1224
1027	use CFClient::OpenGL;	1225	use DC::OpenGL;
1028		1226
1029	sub new {	1227	sub new {
1030	my $class = shift;	1228	my $class = shift;
1031		1229
1032	$class->SUPER::new (	1230	$class->SUPER::new (
…		…
1042	my ($w, $h) = @$self{qw(w h)};	1240	my ($w, $h) = @$self{qw(w h)};
1043		1241
1044	glEnable GL_BLEND;	1242	glEnable GL_BLEND;
1045	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	1243	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1046	glColor_premultiply @{ $self->{bg} };	1244	glColor_premultiply @{ $self->{bg} };
1047
1048	glBegin GL_QUADS;
1049	glVertex 0 , 0;
1050	glVertex 0 , $h;
1051	glVertex $w, $h;	1245	glRect 0, 0, $w, $h;
1052	glVertex $w, 0;
1053	glEnd;
1054
1055	glDisable GL_BLEND;	1246	glDisable GL_BLEND;
1056	}	1247	}
1057		1248
1058	$self->SUPER::_draw;	1249	$self->SUPER::_draw;
1059	}	1250	}
1060		1251
1061	#############################################################################	1252	#############################################################################
1062		1253
1063	package CFClient::UI::FancyFrame;	1254	package DC::UI::FancyFrame;
1064		1255
1065	our @ISA = CFClient::UI::Bin::;	1256	our @ISA = DC::UI::Bin::;
1066		1257
1067	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;
1068		1359
1069	my $bg =	1360	my $bg =
1070	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",	1361	new_from_resource DC::Texture "d1_bg.png",
1071	mipmap => 1, wrap => 1;	1362	mipmap => 1, wrap => 1;
1072		1363
1073	my @border =	1364	my @border =
1074	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1365	map { new_from_resource DC::Texture $_, mipmap => 1 }
1075	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);
1076		1371
1077	sub new {	1372	sub new {
1078	my ($class, %arg) = @_;	1373	my ($class, %arg) = @_;
1079		1374
1080	my $self = $class->SUPER::new (	1375	my $self = $class->SUPER::new (
1081	bg => [1, 1, 1, 1],	1376	bg => [1, 1, 1, 1],
1082	border_bg => [1, 1, 1, 1],	1377	border_bg => [1, 1, 1, 1],
1083	border => 0.6,	1378	border => 0.8,
1084	can_events => 1,	1379	can_events => 1,
1085	min_w => 16,	1380	min_w => 64,
1086	min_h => 16,	1381	min_h => 32,
1087	%arg,	1382	%arg,
1088	);	1383	);
1089		1384
1090	$self->{title_widget} = new CFClient::UI::Label	1385	$self->{title_widget} = new DC::UI::Label
1091	align => 0,	1386	align => 0.5,
1092	valign => 1,	1387	valign => 1,
1093	text => $self->{title},	1388	text => $self->{title},
1094	fontsize => $self->{border},	1389	fontsize => $self->{border},
1095	if exists $self->{title};	1390	if exists $self->{title};
1096		1391
1097	if ($self->{has_close_button}) {	1392	if ($self->{has_close_button}) {
1098	$self->{close_button} =	1393	$self->{close_button} =
1099	new CFClient::UI::ImageButton	1394	new DC::UI::ImageButton
1100	path => 'x1_close.png',	1395	path => 'x1_close.png',
1101	on_activate => sub { $self->hide };	1396	on_activate => sub { $self->emit ("delete") };
1102		1397
1103	$self->CFClient::UI::Container::add ($self->{close_button});	1398	$self->DC::UI::Container::add ($self->{close_button});
1104	}	1399	}
1105		1400
1106	$self	1401	$self
1107	}	1402	}
1108		1403
1109	sub add {	1404	sub add {
1110	my ($self, @widgets) = @_;	1405	my ($self, @widgets) = @_;
1111		1406
1112	$self->SUPER::add (@widgets);	1407	$self->SUPER::add (@widgets);
1113	$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};
1114	$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};
1115	}	1410	}
1116		1411
1117	sub border {	1412	sub border {
1118	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
1119	}	1423	}
1120		1424
1121	sub size_request {	1425	sub size_request {
1122	my ($self) = @_;	1426	my ($self) = @_;
1123		1427
…		…
1152	$self->child->configure ($border, $border, $w, $h);	1456	$self->child->configure ($border, $border, $w, $h);
1153		1457
1154	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)	1458	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1155	if $self->{close_button};	1459	if $self->{close_button};
1156		1460
		1461	1
		1462	}
		1463
		1464	sub invoke_delete {
		1465	my ($self) = @_;
		1466
		1467	$self->hide;
		1468
1157	1	1469	1
1158	}	1470	}
1159		1471
1160	sub invoke_button_down {	1472	sub invoke_button_down {
1161	my ($self, $ev, $x, $y) = @_;	1473	my ($self, $ev, $x, $y) = @_;
…		…
1219	$self->{motion}->($ev, $x, $y) if $self->{motion};	1531	$self->{motion}->($ev, $x, $y) if $self->{motion};
1220		1532
1221	! ! $self->{motion}	1533	! ! $self->{motion}
1222	}	1534	}
1223		1535
		1536	sub invoke_visibility_change {
		1537	my ($self, $visible) = @_;
		1538
		1539	delete $self->{motion} unless $visible;
		1540
		1541	0
		1542	}
		1543
1224	sub _draw {	1544	sub _draw {
1225	my ($self) = @_;	1545	my ($self) = @_;
1226		1546
1227	my $child = $self->{children}[0];	1547	my $child = $self->{children}[0];
1228		1548
…		…
1232	glEnable GL_TEXTURE_2D;	1552	glEnable GL_TEXTURE_2D;
1233	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1553	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1234		1554
1235	my $border = $self->border;	1555	my $border = $self->border;
1236		1556
		1557	if ($border) {
1237	glColor @{ $self->{border_bg} };	1558	glColor @{ $self->{border_bg} };
1238	$border[0]->draw_quad_alpha (0, 0, $w, $border);	1559	$border[0]->draw_quad_alpha ( 0, 0, $w, $border);
1239	$border[1]->draw_quad_alpha (0, $border, $border, $ch);	1560	$border[1]->draw_quad_alpha ( 0, $border, $border, $ch);
1240	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1561	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1241	$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	}
1242		1578
1243	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1579	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1244	glColor @{ $self->{bg} };	1580	glColor @{ $self->{bg} };
1245		1581
1246	# TODO: repeat texture not scale	1582	# TODO: repeat texture not scale
…		…
1265	if $self->{close_button};	1601	if $self->{close_button};
1266	}	1602	}
1267		1603
1268	#############################################################################	1604	#############################################################################
1269		1605
1270	package CFClient::UI::Table;	1606	package DC::UI::Table;
1271		1607
1272	our @ISA = CFClient::UI::Base::;	1608	our @ISA = DC::UI::Container::;
1273		1609
1274	use List::Util qw(max sum);	1610	use List::Util qw(max sum);
1275		1611
1276	use CFClient::OpenGL;	1612	use DC::OpenGL;
1277		1613
1278	sub new {	1614	sub new {
1279	my $class = shift;	1615	my $class = shift;
1280		1616
1281	$class->SUPER::new (	1617	$class->SUPER::new (
1282	col_expand => [],	1618	col_expand => [],
		1619	row_expand => [],
1283	@_,	1620	@_,
1284	)	1621	)
1285	}	1622	}
1286		1623
1287	sub children {
1288	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1289	}
1290
1291	sub add {	1624	sub add {
1292	my ($self, $x, $y, $child) = @_;	1625	my ($self, @widgets) = @_;
1293		1626
1294	$child->set_parent ($self);	1627	for my $child (@widgets) {
1295	$self->{children}[$y][$x] = $child;	1628	$child->{c_rowspan} ||= 1;
		1629	$child->{c_colspan} ||= 1;
		1630	}
1296		1631
1297	$self->realloc;	1632	$self->SUPER::add (@widgets);
1298	}	1633	}
1299		1634
1300	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 {
1301	my ($self, $child) = @_;	1653	my ($self) = @_;
1302		1654
1303	# TODO: not yet implemented	1655	my (@w, @h);
1304	}
1305
1306	# TODO: move to container class maybe? send children a signal on removal?
1307	sub clear {
1308	my ($self) = @_;
1309		1656
1310	my @children = $self->children;	1657	my @children = $self->children;
1311	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	}
1312		1668	}
1313	for (@children) {
1314	delete $_->{parent};
1315	$_->hide;
1316	}
1317		1669
1318	$self->realloc;	1670	# second pass, rows
1319	}	1671	for my $widget (sort { $a->{c_rowspan} <=> $b->{c_rowspan} } @children) {
1320
1321	sub get_wh {
1322	my ($self) = @_;
1323
1324	my (@w, @h);
1325
1326	for my $y (0 .. $#{$self->{children}}) {
1327	my $row = $self->{children}[$y]
1328	or next;
1329
1330	for my $x (0 .. $#$row) {
1331	my $widget = $row->[$x]
1332	or next;
1333	my ($w, $h) = @$widget{qw(req_w req_h)};	1672	my ($r, $h, $rs) = @$widget{qw(c_row req_h c_rowspan)};
1334		1673
1335	$w[$x] = max $w[$x], $w;	1674	my $sh = sum @h[$r .. $r + $rs - 1];
1336	$h[$y] = max $h[$y], $h;	1675
		1676	if ($h > $sh) {
		1677	$_ += ($h - $sh) / ($_ ? $sh / $_ : $rs) for @h[$r .. $r + $rs - 1];
1337	}	1678	}
1338	}	1679	}
1339		1680
1340	(\@w, \@h)	1681	(\@w, \@h)
1341	}	1682	}
…		…
1357	my ($ws, $hs) = $self->get_wh;	1698	my ($ws, $hs) = $self->get_wh;
1358		1699
1359	my $req_w = (sum @$ws) || 1;	1700	my $req_w = (sum @$ws) || 1;
1360	my $req_h = (sum @$hs) || 1;	1701	my $req_h = (sum @$hs) || 1;
1361		1702
1362	# TODO: nicer code && do row_expand	1703	# now linearly scale the rows/columns to the allocated size
1363	my @col_expand = @{$self->{col_expand}};	1704	my @col_expand = @{$self->{col_expand}};
1364	@col_expand = (1) x @$ws unless @col_expand;	1705	@col_expand = (1) x @$ws unless @col_expand;
1365	my $col_expand = (sum @col_expand) || 1;	1706	my $col_expand = (sum @col_expand) || 1;
1366		1707
1367	# linearly scale sizes
1368	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;	1708	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1369	$hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1370		1709
1371	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
1372	CFClient::UI::harmonize $hs;	1718	DC::UI::harmonize $hs;
1373		1719
1374	my $y;	1720	my @x; for (0 .. $#$ws) { $x[$_ + 1] = $x[$_] + $ws->[$_] }
		1721	my @y; for (0 .. $#$hs) { $y[$_ + 1] = $y[$_] + $hs->[$_] }
1375		1722
1376	for my $r (0 .. $#{$self->{children}}) {	1723	for my $widget ($self->children) {
1377	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)};
1378	or next;
1379		1725
1380	my $x = 0;	1726	$widget->configure (
1381	my $row_h = $hs->[$r];	1727	$x[$c], $y[$r],
		1728	$x[$c + $cs] - $x[$c], $y[$r + $rs] - $y[$r],
1382		1729	);
1383	for my $c (0 .. $#$row) {	1730	}
1384	my $col_w = $ws->[$c];
1385		1731
1386	if (my $widget = $row->[$c]) {	1732	1
1387	$widget->configure ($x, $y, $col_w, $row_h);	1733	}
1388	}
1389		1734
1390	$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};
1391	}	1762	}
		1763	}
1392		1764
1393	$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});
1394	}	1796	}
1395		1797
1396	1	1798	1
1397	}	1799	}
1398		1800
1399	sub find_widget {
1400	my ($self, $x, $y) = @_;
1401
1402	$x -= $self->{x};
1403	$y -= $self->{y};
1404
1405	my $res;
1406
1407	for (grep $_, map @$_, grep $_, @{ $self->{children} }) {
1408	$res = $_->find_widget ($x, $y)
1409	and return $res;
1410	}
1411
1412	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
1413	}
1414
1415	sub _draw {
1416	my ($self) = @_;
1417
1418	for (grep $_, @{$self->{children}}) {
1419	$_->draw for grep $_, @$_;
1420	}
1421	}
1422
1423	#############################################################################	1801	#############################################################################
1424		1802
1425	package CFClient::UI::Box;	1803	package DC::UI::Box;
1426		1804
1427	our @ISA = CFClient::UI::Container::;	1805	our @ISA = DC::UI::Container::;
1428		1806
1429	sub size_request {	1807	sub size_request {
1430	my ($self) = @_;	1808	my ($self) = @_;
		1809
		1810	my @children = $self->visible_children;
1431		1811
1432	$self->{vertical}	1812	$self->{vertical}
1433	? (	1813	? (
1434	(List::Util::max map $_->{req_w}, @{$self->{children}}),	1814	(List::Util::max map $_->{req_w}, @children),
1435	(List::Util::sum map $_->{req_h}, @{$self->{children}}),	1815	(List::Util::sum map $_->{req_h}, @children),
1436	)	1816	)
1437	: (	1817	: (
1438	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1818	(List::Util::sum map $_->{req_w}, @children),
1439	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1819	(List::Util::max map $_->{req_h}, @children),
1440	)	1820	)
1441	}	1821	}
1442		1822
1443	sub invoke_size_allocate {	1823	sub invoke_size_allocate {
1444	my ($self, $w, $h) = @_;	1824	my ($self, $w, $h) = @_;
…		…
1465	$req[$_] += $space * $children[$_]{expand}	1845	$req[$_] += $space * $children[$_]{expand}
1466	for 0 .. $#children;	1846	for 0 .. $#children;
1467	}	1847	}
1468	}	1848	}
1469		1849
1470	CFClient::UI::harmonize \@req;	1850	DC::UI::harmonize \@req;
1471		1851
1472	my $pos = 0;	1852	my $pos = 0;
1473	for (0 .. $#children) {	1853	for (0 .. $#children) {
1474	my $alloc = $req[$_];	1854	my $alloc = $req[$_];
1475	$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));
…		…
1480	1	1860	1
1481	}	1861	}
1482		1862
1483	#############################################################################	1863	#############################################################################
1484		1864
1485	package CFClient::UI::HBox;	1865	package DC::UI::HBox;
1486		1866
1487	our @ISA = CFClient::UI::Box::;	1867	our @ISA = DC::UI::Box::;
1488		1868
1489	sub new {	1869	sub new {
1490	my $class = shift;	1870	my $class = shift;
1491		1871
1492	$class->SUPER::new (	1872	$class->SUPER::new (
…		…
1495	)	1875	)
1496	}	1876	}
1497		1877
1498	#############################################################################	1878	#############################################################################
1499		1879
1500	package CFClient::UI::VBox;	1880	package DC::UI::VBox;
1501		1881
1502	our @ISA = CFClient::UI::Box::;	1882	our @ISA = DC::UI::Box::;
1503		1883
1504	sub new {	1884	sub new {
1505	my $class = shift;	1885	my $class = shift;
1506		1886
1507	$class->SUPER::new (	1887	$class->SUPER::new (
…		…
1510	)	1890	)
1511	}	1891	}
1512		1892
1513	#############################################################################	1893	#############################################################################
1514		1894
1515	package CFClient::UI::Label;	1895	package DC::UI::Label;
1516		1896
1517	our @ISA = CFClient::UI::DrawBG::;	1897	our @ISA = DC::UI::DrawBG::;
1518		1898
1519	use CFClient::OpenGL;	1899	use DC::OpenGL;
1520		1900
1521	sub new {	1901	sub new {
1522	my ($class, %arg) = @_;	1902	my ($class, %arg) = @_;
1523		1903
1524	my $self = $class->SUPER::new (	1904	my $self = $class->SUPER::new (
…		…
1527	#active_bg => none	1907	#active_bg => none
1528	#font => default_font	1908	#font => default_font
1529	#text => initial text	1909	#text => initial text
1530	#markup => initial narkup	1910	#markup => initial narkup
1531	#max_w => maximum pixel width	1911	#max_w => maximum pixel width
		1912	#style => 0, # render flags
1532	ellipsise => 3, # end	1913	ellipsise => 3, # end
1533	layout => (new CFClient::Layout),	1914	layout => (new DC::Layout),
1534	fontsize => 1,	1915	fontsize => 1,
1535	align => -1,	1916	align => 0.5,
1536	valign => -1,	1917	valign => 0.5,
1537	padding_x => 2,	1918	padding_x => 4,
1538	padding_y => 2,	1919	padding_y => 2,
1539	can_events => 0,	1920	can_events => 0,
1540	%arg	1921	%arg
1541	);	1922	);
1542		1923
1543	if (exists $self->{template}) {	1924	if (exists $self->{template}) {
1544	my $layout = new CFClient::Layout;	1925	my $layout = new DC::Layout;
1545	$layout->set_text (delete $self->{template});	1926	$layout->set_text (delete $self->{template});
1546	$self->{template} = $layout;	1927	$self->{template} = $layout;
1547	}	1928	}
1548		1929
1549	if (exists $self->{markup}) {	1930	if (exists $self->{markup}) {
…		…
1553	}	1934	}
1554		1935
1555	$self	1936	$self
1556	}	1937	}
1557		1938
1558	sub escape($) {
1559	local $_ = $_[0];
1560
1561	s/&/&amp;/g;
1562	s/>/&gt;/g;
1563	s/</&lt;/g;
1564
1565	$_
1566	}
1567
1568	sub update {	1939	sub update {
1569	my ($self) = @_;	1940	my ($self) = @_;
1570		1941
1571	delete $self->{texture};	1942	delete $self->{texture};
1572	$self->SUPER::update;	1943	$self->SUPER::update;
…		…
1577		1948
1578	delete $self->{ox};	1949	delete $self->{ox};
1579	$self->SUPER::realloc;	1950	$self->SUPER::realloc;
1580	}	1951	}
1581		1952
		1953	sub clear {
		1954	my ($self) = @_;
		1955
		1956	$self->set_text ("");
		1957	}
		1958
1582	sub set_text {	1959	sub set_text {
1583	my ($self, $text) = @_;	1960	my ($self, $text) = @_;
1584		1961
1585	return if $self->{text} eq "T$text";	1962	return if $self->{text} eq "T$text";
1586	$self->{text} = "T$text";	1963	$self->{text} = "T$text";
1587		1964
1588	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1589	$self->{layout}->set_text ($text);	1965	$self->{layout}->set_text ($text);
1590		1966
1591	delete $self->{size_req};	1967	delete $self->{size_req};
1592	$self->realloc;	1968	$self->realloc;
1593	$self->update;	1969	$self->update;
…		…
1599	return if $self->{text} eq "M$markup";	1975	return if $self->{text} eq "M$markup";
1600	$self->{text} = "M$markup";	1976	$self->{text} = "M$markup";
1601		1977
1602	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1978	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1603		1979
1604	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1605	$self->{layout}->set_markup ($markup);	1980	$self->{layout}->set_markup ($markup);
1606		1981
1607	delete $self->{size_req};	1982	delete $self->{size_req};
1608	$self->realloc;	1983	$self->realloc;
1609	$self->update;	1984	$self->update;
…		…
1611		1986
1612	sub size_request {	1987	sub size_request {
1613	my ($self) = @_;	1988	my ($self) = @_;
1614		1989
1615	$self->{size_req} ||= do {	1990	$self->{size_req} ||= do {
		1991	my ($max_w, $max_h) = $self->get_max_wh;
		1992
1616	$self->{layout}->set_font ($self->{font}) if $self->{font};	1993	$self->{layout}->set_font ($self->{font}) if $self->{font};
1617	$self->{layout}->set_width ($self->{max_w} || -1);	1994	$self->{layout}->set_width ($max_w);
1618	$self->{layout}->set_ellipsise ($self->{ellipsise});	1995	$self->{layout}->set_ellipsise ($self->{ellipsise});
1619	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1996	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1620	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1997	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1621		1998
1622	my ($w, $h) = $self->{layout}->size;	1999	my ($w, $h) = $self->{layout}->size;
1623		2000
1624	if (exists $self->{template}) {	2001	if (exists $self->{template}) {
1625	$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);
1626	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	2004	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1627		2005
1628	my ($w2, $h2) = $self->{template}->size;	2006	my ($w2, $h2) = $self->{template}->size;
1629		2007
1630	$w = List::Util::max $w, $w2;	2008	$w = List::Util::max $w, $w2;
…		…
1654		2032
1655	sub set_fontsize {	2033	sub set_fontsize {
1656	my ($self, $fontsize) = @_;	2034	my ($self, $fontsize) = @_;
1657		2035
1658	$self->{fontsize} = $fontsize;	2036	$self->{fontsize} = $fontsize;
		2037	delete $self->{size_req};
1659	delete $self->{texture};	2038	delete $self->{texture};
1660		2039
1661	$self->realloc;	2040	$self->realloc;
1662	}	2041	}
1663		2042
1664	sub reconfigure {	2043	sub reconfigure {
1665	my ($self) = @_;	2044	my ($self) = @_;
1666		2045
1667	delete $self->{size_req};	2046	delete $self->{size_req};
		2047	delete $self->{texture};
1668		2048
1669	$self->SUPER::reconfigure;	2049	$self->SUPER::reconfigure;
1670	}	2050	}
1671		2051
1672	sub _draw {	2052	sub _draw {
1673	my ($self) = @_;	2053	my ($self) = @_;
1674		2054
1675	$self->SUPER::_draw; # draw background, if applicable	2055	$self->SUPER::_draw; # draw background, if applicable
1676		2056
1677	my $tex = $self->{texture} ||= do {	2057	my $size = $self->{texture} ||= do {
1678	$self->{layout}->set_foreground (@{$self->{fg}});	2058	$self->{layout}->set_foreground (@{$self->{fg}});
1679	$self->{layout}->set_font ($self->{font}) if $self->{font};	2059	$self->{layout}->set_font ($self->{font}) if $self->{font};
1680	$self->{layout}->set_width ($self->{w});	2060	$self->{layout}->set_width ($self->{w});
1681	$self->{layout}->set_ellipsise ($self->{ellipsise});	2061	$self->{layout}->set_ellipsise ($self->{ellipsise});
1682	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	2062	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1683	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2063	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1684		2064
1685	new_from_layout CFClient::Texture $self->{layout}	2065	[$self->{layout}->size]
1686	};	2066	};
1687		2067
1688	unless (exists $self->{ox}) {	2068	unless (exists $self->{ox}) {
1689	$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);
1690	: $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);
1691	: ($self->{w} - $tex->{w}) * 0.5);
1692		2071
1693	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	2072	$self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1694	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1695	: ($self->{h} - $tex->{h}) * 0.5);
1696	};	2073	};
1697		2074
1698	glEnable GL_TEXTURE_2D;	2075	# unless ($self->{list}) {
1699		2076	# $self->{list} = DC::OpenGL::glGenList;
1700	my $w = List::Util::min $self->{w} + 4, $tex->{w};	2077	# DC::OpenGL::glNewList $self->{list};
1701	my $h = List::Util::min $self->{h} + 2, $tex->{h};	2078	# $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1702		2079	# DC::OpenGL::glEndList;
1703	if ($tex->{format} == GL_ALPHA) {
1704	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1705	glColor @{$self->{fg}};
1706	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1707	} else {
1708	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1709	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1710	}	2080	# }
		2081	#
		2082	# DC::OpenGL::glCallList $self->{list};
1711		2083
1712	glDisable GL_TEXTURE_2D;	2084	$self->{layout}->draw;
1713	}	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	#}
1714		2094
1715	#############################################################################	2095	#############################################################################
1716		2096
1717	package CFClient::UI::EntryBase;	2097	package DC::UI::EntryBase;
1718		2098
1719	our @ISA = CFClient::UI::Label::;	2099	our @ISA = DC::UI::Label::;
1720		2100
1721	use CFClient::OpenGL;	2101	use DC::OpenGL;
1722		2102
1723	sub new {	2103	sub new {
1724	my $class = shift;	2104	my $class = shift;
1725		2105
1726	$class->SUPER::new (	2106	$class->SUPER::new (
1727	fg => [1, 1, 1],	2107	fg => [1, 1, 1],
1728	bg => [0, 0, 0, 0.2],	2108	bg => [0, 0, 0, 0.2],
		2109	outline => undef,
1729	active_bg => [1, 1, 1, 0.5],	2110	active_bg => [0, 0, 1, .2],
1730	active_fg => [0, 0, 0],	2111	active_fg => [1, 1, 1],
		2112	active_outline => [1, 1, 0],
1731	can_hover => 1,	2113	can_hover => 1,
1732	can_focus => 1,	2114	can_focus => 1,
		2115	align => 0,
1733	valign => 0,	2116	valign => 0.5,
1734	can_events => 1,	2117	can_events => 1,
		2118	ellipsise => 0,
		2119	padding_x => 4,
		2120	padding_y => 2,
1735	#text => ...	2121	#text => ...
1736	#hidden => "*",	2122	#hidden => "*",
1737	@_	2123	@_
1738	)	2124	)
1739	}	2125	}
…		…
1784	my $sym = $ev->{sym};	2170	my $sym = $ev->{sym};
1785	my $uni = $ev->{unicode};	2171	my $uni = $ev->{unicode};
1786		2172
1787	my $text = $self->get_text;	2173	my $text = $self->get_text;
1788		2174
1789	if ($uni == 8) {	2175	$self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text;
		2176
		2177	if ($sym == DC::SDLK_BACKSPACE) {
1790	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	2178	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1791	} elsif ($uni == 127) {	2179	} elsif ($sym == DC::SDLK_DELETE) {
1792	substr $text, $self->{cursor}, 1, "";	2180	substr $text, $self->{cursor}, 1, "";
1793	} elsif ($sym == CFClient::SDLK_LEFT) {	2181	} elsif ($sym == DC::SDLK_LEFT) {
1794	--$self->{cursor} if $self->{cursor};	2182	--$self->{cursor} if $self->{cursor};
1795	} elsif ($sym == CFClient::SDLK_RIGHT) {	2183	} elsif ($sym == DC::SDLK_RIGHT) {
1796	++$self->{cursor} if $self->{cursor} < length $self->{text};	2184	++$self->{cursor} if $self->{cursor} < length $self->{text};
1797	} 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 = "";
1798	$self->{cursor} = 0;	2199	$self->{cursor} = 0;
1799	} elsif ($sym == CFClient::SDLK_END) {
1800	$self->{cursor} = length $text;
1801	} elsif ($uni == 27) {	2200	} elsif ($uni == 27) {
1802	$self->emit ('escape');	2201	$self->emit ('escape');
1803	} elsif ($uni) {	2202	} elsif ($uni == 0x0d) {
		2203	substr $text, $self->{cursor}++, 0, "\012";
		2204	} elsif ($uni >= 0x20) {
1804	substr $text, $self->{cursor}++, 0, chr $uni;	2205	substr $text, $self->{cursor}++, 0, chr $uni;
1805	} else {	2206	} else {
1806	return 0;	2207	return 0;
1807	}	2208	}
1808		2209
1809	$self->_set_text ($text);	2210	$self->_set_text ($text);
1810		2211
1811	$self->realloc;	2212	$self->realloc;
		2213	$self->update;
1812		2214
1813	1	2215	1
1814	}	2216	}
1815		2217
1816	sub invoke_focus_in {	2218	sub invoke_focus_in {
…		…
1828		2230
1829	my $idx = $self->{layout}->xy_to_index ($x, $y);	2231	my $idx = $self->{layout}->xy_to_index ($x, $y);
1830		2232
1831	# byte-index to char-index	2233	# byte-index to char-index
1832	my $text = $self->{text};	2234	my $text = $self->{text};
1833	utf8::encode $text;	2235	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1834	$self->{cursor} = length substr $text, 0, $idx;	2236	$self->{cursor} = length $text;
1835		2237
1836	$self->_set_text ($self->{text});	2238	$self->_set_text ($self->{text});
1837	$self->update;	2239	$self->update;
1838		2240
1839	1	2241	1
…		…
1858	glColor_premultiply @{$self->{bg}};	2260	glColor_premultiply @{$self->{bg}};
1859	}	2261	}
1860		2262
1861	glEnable GL_BLEND;	2263	glEnable GL_BLEND;
1862	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2264	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1863	glBegin GL_QUADS;
1864	glVertex 0 , 0;
1865	glVertex 0 , $self->{h};
1866	glVertex $self->{w}, $self->{h};	2265	glRect 0, 0, $self->{w}, $self->{h};
1867	glVertex $self->{w}, 0;
1868	glEnd;
1869	glDisable GL_BLEND;	2266	glDisable GL_BLEND;
1870		2267
1871	$self->SUPER::_draw;	2268	$self->SUPER::_draw;
1872		2269
1873	#TODO: force update every cursor change :(	2270	#TODO: force update every cursor change :(
…		…
1875		2272
1876	unless (exists $self->{cur_h}) {	2273	unless (exists $self->{cur_h}) {
1877	my $text = substr $self->{text}, 0, $self->{cursor};	2274	my $text = substr $self->{text}, 0, $self->{cursor};
1878	utf8::encode $text;	2275	utf8::encode $text;
1879		2276
1880	@$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);
1881	}	2278	}
1882		2279
1883	glColor @{$self->{fg}};	2280	glColor_premultiply @{$self->{active_fg}};
1884	glBegin GL_LINES;	2281	glBegin GL_LINES;
1885	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};	2282	glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy};
1886	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};
1887	glEnd;	2284	glEnd;
1888	}
1889	}
1890		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
1891	package CFClient::UI::Entry;	2304	package DC::UI::Entry;
1892		2305
1893	our @ISA = CFClient::UI::EntryBase::;	2306	our @ISA = DC::UI::EntryBase::;
1894		2307
1895	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
1896		2319
1897	sub invoke_key_down {	2320	sub invoke_key_down {
1898	my ($self, $ev) = @_;	2321	my ($self, $ev) = @_;
1899		2322
1900	my $sym = $ev->{sym};	2323	my $sym = $ev->{sym};
1901		2324
1902	if ($sym == 13) {	2325	if ($ev->{uni} == 0x0d || $sym == 13) {
1903	unshift @{$self->{history}},	2326	unshift @{$self->{history}},
1904	my $txt = $self->get_text;	2327	my $txt = $self->get_text;
1905		2328
1906	$self->{history_pointer} = -1;	2329	$self->{history_pointer} = -1;
1907	$self->{history_saveback} = '';	2330	$self->{history_saveback} = '';
1908	$self->emit (activate => $txt);	2331	$self->emit (activate => $txt);
1909	$self->update;	2332	$self->update;
1910		2333
1911	} elsif ($sym == CFClient::SDLK_UP) {	2334	} elsif ($sym == DC::SDLK_UP) {
1912	if ($self->{history_pointer} < 0) {	2335	if ($self->{history_pointer} < 0) {
1913	$self->{history_saveback} = $self->get_text;	2336	$self->{history_saveback} = $self->get_text;
1914	}	2337	}
1915	if (@{$self->{history} || []} > 0) {	2338	if (@{$self->{history} || []} > 0) {
1916	$self->{history_pointer}++;	2339	$self->{history_pointer}++;
…		…
1918	$self->{history_pointer} = @{$self->{history} || []} - 1;	2341	$self->{history_pointer} = @{$self->{history} || []} - 1;
1919	}	2342	}
1920	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2343	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1921	}	2344	}
1922		2345
1923	} elsif ($sym == CFClient::SDLK_DOWN) {	2346	} elsif ($sym == DC::SDLK_DOWN) {
1924	$self->{history_pointer}--;	2347	$self->{history_pointer}--;
1925	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	2348	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1926		2349
1927	if ($self->{history_pointer} >= 0) {	2350	if ($self->{history_pointer} >= 0) {
1928	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2351	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1929	} else {	2352	} else {
		2353	if (defined $self->{history_saveback}) {
1930	$self->set_text ($self->{history_saveback});	2354	$self->set_text ($self->{history_saveback});
		2355	$self->{history_saveback} = undef;
		2356	}
1931	}	2357	}
1932		2358
1933	} else {	2359	} else {
1934	return $self->SUPER::invoke_key_down ($ev)	2360	return $self->SUPER::invoke_key_down ($ev)
1935	}	2361	}
…		…
1937	1	2363	1
1938	}	2364	}
1939		2365
1940	#############################################################################	2366	#############################################################################
1941		2367
1942	package CFClient::UI::Button;	2368	package DC::UI::TextEdit;
1943		2369
1944	our @ISA = CFClient::UI::Label::;	2370	our @ISA = DC::UI::EntryBase::;
1945		2371
1946	use CFClient::OpenGL;	2372	use DC::OpenGL;
1947
1948	my @tex =
1949	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1950	qw(b1_button_active.png);
1951		2373
1952	sub new {	2374	sub new {
1953	my $class = shift;	2375	my $class = shift;
1954		2376
1955	$class->SUPER::new (	2377	$class->SUPER::new (
1956	padding_x => 4,
1957	padding_y => 4,	2378	padding_y => 4,
1958	fg => [1, 1, 1],	2379
1959	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 (
1960	can_hover => 1,	2431	can_hover => 1,
1961	align => 0,	2432	align => 0.5,
1962	valign => 0,	2433	valign => 0.5,
1963	can_events => 1,	2434	can_events => 1,
1964	@_	2435	@_
1965	)	2436	)
1966	}	2437	}
1967		2438
…		…
1976	}	2447	}
1977		2448
1978	sub _draw {	2449	sub _draw {
1979	my ($self) = @_;	2450	my ($self) = @_;
1980		2451
1981	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1982
1983	glEnable GL_TEXTURE_2D;	2452	glEnable GL_TEXTURE_2D;
1984	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2453	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1985	glColor 0, 0, 0, 1;	2454	glColor 0, 0, 0, 1;
1986		2455
		2456	my $tex = $tex[$GRAB == $self];
1987	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2457	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1988		2458
1989	glDisable GL_TEXTURE_2D;	2459	glDisable GL_TEXTURE_2D;
1990		2460
1991	$self->SUPER::_draw;	2461	$self->SUPER::_draw;
1992	}	2462	}
1993		2463
1994	#############################################################################	2464	#############################################################################
1995		2465
1996	package CFClient::UI::ImageButton;	2466	package DC::UI::Button;
1997		2467
1998	our @ISA = CFClient::UI::Image::;	2468	our @ISA = DC::UI::Label::;
1999		2469
2000	use CFClient::OpenGL;	2470	use DC::OpenGL;
2001		2471
2002	my %textures;	2472	my @tex =
		2473	map { new_from_resource DC::Texture $_, mipmap => 1 }
		2474	qw(b1_button_inactive.png b1_button_active.png);
2003		2475
2004	sub new {	2476	sub new {
2005	my $class = shift;	2477	my $class = shift;
2006		2478
2007	my $self = $class->SUPER::new (	2479	$class->SUPER::new (
2008	padding_x => 4,	2480	padding_x => 8,
2009	padding_y => 4,	2481	padding_y => 4,
2010	fg => [1, 1, 1],	2482	fg => [1.0, 1.0, 1.0],
2011	active_fg => [0, 0, 1],	2483	active_fg => [0.8, 0.8, 0.8],
2012	can_hover => 1,	2484	can_hover => 1,
2013	align => 0,	2485	align => 0.5,
2014	valign => 0,	2486	valign => 0.5,
2015	can_events => 1,	2487	can_events => 1,
2016	@_	2488	@_
2017	);	2489	)
2018	}	2490	}
2019		2491
2020	sub invoke_button_up {	2492	sub invoke_button_up {
2021	my ($self, $ev, $x, $y) = @_;	2493	my ($self, $ev, $x, $y) = @_;
2022		2494
…		…
2025	&& $y >= 0 && $y < $self->{h};	2497	&& $y >= 0 && $y < $self->{h};
2026		2498
2027	1	2499	1
2028	}	2500	}
2029		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
2030	#############################################################################	2519	#############################################################################
2031		2520
2032	package CFClient::UI::CheckBox;	2521	package DC::UI::CheckBox;
2033		2522
2034	our @ISA = CFClient::UI::DrawBG::;	2523	our @ISA = DC::UI::DrawBG::;
2035		2524
2036	my @tex =	2525	my @tex =
2037	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2526	map { new_from_resource DC::Texture $_, mipmap => 1 }
2038	qw(c1_checkbox_bg.png c1_checkbox_active.png);	2527	qw(c1_checkbox_bg.png c1_checkbox_active.png);
2039		2528
2040	use CFClient::OpenGL;	2529	use DC::OpenGL;
2041		2530
2042	sub new {	2531	sub new {
2043	my $class = shift;	2532	my $class = shift;
2044		2533
2045	$class->SUPER::new (	2534	$class->SUPER::new (
		2535	fontsize => 1,
2046	padding_x => 2,	2536	padding_x => 2,
2047	padding_y => 2,	2537	padding_y => 2,
2048	fg => [1, 1, 1],	2538	fg => [1, 1, 1],
2049	active_fg => [1, 1, 0],	2539	active_fg => [1, 1, 0],
2050	bg => [0, 0, 0, 0.2],	2540	bg => [0, 0, 0, 0.2],
…		…
2056	}	2546	}
2057		2547
2058	sub size_request {	2548	sub size_request {
2059	my ($self) = @_;	2549	my ($self) = @_;
2060		2550
2061	(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;
2062	}	2560	}
2063		2561
2064	sub invoke_button_down {	2562	sub invoke_button_down {
2065	my ($self, $ev, $x, $y) = @_;	2563	my ($self, $ev, $x, $y) = @_;
2066		2564
2067	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2565	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2068	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2566	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2069	$self->{state} = !$self->{state};	2567	$self->toggle;
2070	$self->emit (changed => $self->{state});
2071	} else {	2568	} else {
2072	return 0	2569	return 0
2073	}	2570	}
2074		2571
2075	1	2572	1
…		…
2078	sub _draw {	2575	sub _draw {
2079	my ($self) = @_;	2576	my ($self) = @_;
2080		2577
2081	$self->SUPER::_draw;	2578	$self->SUPER::_draw;
2082		2579
2083	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;	2580	glTranslate $self->{padding_x}, $self->{padding_y}, 0;
2084		2581
2085	my ($w, $h) = @$self{qw(w h)};	2582	my ($w, $h) = @$self{qw(w h)};
2086		2583
2087	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;
2088		2585
…		…
2095	glDisable GL_TEXTURE_2D;	2592	glDisable GL_TEXTURE_2D;
2096	}	2593	}
2097		2594
2098	#############################################################################	2595	#############################################################################
2099		2596
2100	package CFClient::UI::Image;	2597	package DC::UI::Image;
2101		2598
2102	our @ISA = CFClient::UI::Base::;	2599	our @ISA = DC::UI::Base::;
2103		2600
2104	use CFClient::OpenGL;	2601	use DC::OpenGL;
2105		2602
2106	our %texture_cache;	2603	our %texture_cache;
2107		2604
2108	sub new {	2605	sub new {
2109	my $class = shift;	2606	my $class = shift;
2110		2607
2111	my $self = $class->SUPER::new (	2608	my $self = $class->SUPER::new (
2112	can_events => 0,	2609	can_events => 0,
		2610	scale => 1,
2113	@_,	2611	@_,
2114	);	2612	);
2115		2613
		2614	$self->{path} || $self->{tex}
		2615	or Carp::croak "'path' or 'tex' attributes required";
		2616
		2617	$self->{tex} ||= $texture_cache{$self->{path}} ||=
		2618	new_from_resource DC::Texture $self->{path}, mipmap => 1;
		2619
		2620	DC::weaken $texture_cache{$self->{path}};
		2621
		2622	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
		2623
		2624	$self
		2625	}
		2626
		2627	sub STORABLE_freeze {
		2628	my ($self, $cloning) = @_;
		2629
2116	$self->{path}	2630	$self->{path}
2117	or Carp::croak "required attribute 'path' not set";	2631	or die "cannot serialise DC::UI::Image on non-loadable images\n";
2118		2632
2119	$self->{tex} = $texture_cache{$self->{path}} ||=	2633	$self->{path}
2120	new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;	2634	}
2121		2635
2122	Scalar::Util::weaken $texture_cache{$self->{path}};	2636	sub STORABLE_attach {
		2637	my ($self, $cloning, $path) = @_;
2123		2638
2124	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};	2639	$self->new (path => $path)
2125
2126	$self
2127	}	2640	}
2128		2641
2129	sub size_request {	2642	sub size_request {
2130	my ($self) = @_;	2643	my ($self) = @_;
2131		2644
2132	($self->{tex}{w}, $self->{tex}{h})	2645	(int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
2133	}	2646	}
2134		2647
2135	sub _draw {	2648	sub _draw {
2136	my ($self) = @_;	2649	my ($self) = @_;
2137		2650
…		…
2154	glDisable GL_TEXTURE_2D;	2667	glDisable GL_TEXTURE_2D;
2155	}	2668	}
2156		2669
2157	#############################################################################	2670	#############################################################################
2158		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
2159	package CFClient::UI::VGauge;	2714	package DC::UI::VGauge;
2160		2715
2161	our @ISA = CFClient::UI::Base::;	2716	our @ISA = DC::UI::Base::;
2162		2717
2163	use List::Util qw(min max);	2718	use List::Util qw(min max);
2164		2719
2165	use CFClient::OpenGL;	2720	use DC::OpenGL;
2166		2721
2167	my %tex = (	2722	my %tex = (
2168	food => [	2723	food => [
2169	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2724	map { new_from_resource DC::Texture $_, mipmap => 1 }
2170	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2725	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2171	],	2726	],
2172	grace => [	2727	grace => [
2173	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2728	map { new_from_resource DC::Texture $_, mipmap => 1 }
2174	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/
2175	],	2730	],
2176	hp => [	2731	hp => [
2177	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2732	map { new_from_resource DC::Texture $_, mipmap => 1 }
2178	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2733	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2179	],	2734	],
2180	mana => [	2735	mana => [
2181	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2736	map { new_from_resource DC::Texture $_, mipmap => 1 }
2182	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/
2183	],	2738	],
2184	);	2739	);
2185		2740
2186	# eg. VGauge->new (gauge => 'food'), default gauge: food	2741	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2246	my $ycut1 = max 0, min 1, $ycut;	2801	my $ycut1 = max 0, min 1, $ycut;
2247	my $ycut2 = max 0, min 1, $ycut - 1;	2802	my $ycut2 = max 0, min 1, $ycut - 1;
2248		2803
2249	my $h1 = $self->{h} * (1 - $ycut1);	2804	my $h1 = $self->{h} * (1 - $ycut1);
2250	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);
2251		2809
2252	glEnable GL_BLEND;	2810	glEnable GL_BLEND;
2253	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2811	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2254	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2812	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2255	glEnable GL_TEXTURE_2D;	2813	glEnable GL_TEXTURE_2D;
…		…
2274		2832
2275	if ($t3) {	2833	if ($t3) {
2276	glBindTexture GL_TEXTURE_2D, $t3->{name};	2834	glBindTexture GL_TEXTURE_2D, $t3->{name};
2277	glBegin GL_QUADS;	2835	glBegin GL_QUADS;
2278	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2836	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2279	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2837	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2280	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2838	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2281	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2839	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2282	glEnd;	2840	glEnd;
2283	}	2841	}
2284		2842
2285	glDisable GL_BLEND;	2843	glDisable GL_BLEND;
2286	glDisable GL_TEXTURE_2D;	2844	glDisable GL_TEXTURE_2D;
2287	}	2845	}
2288		2846
2289	#############################################################################	2847	#############################################################################
2290		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
2291	package CFClient::UI::Gauge;	3003	package DC::UI::Gauge;
2292		3004
2293	our @ISA = CFClient::UI::VBox::;	3005	our @ISA = DC::UI::VBox::;
2294		3006
2295	sub new {	3007	sub new {
2296	my ($class, %arg) = @_;	3008	my ($class, %arg) = @_;
2297		3009
2298	my $self = $class->SUPER::new (	3010	my $self = $class->SUPER::new (
…		…
2300	can_hover => 1,	3012	can_hover => 1,
2301	can_events => 1,	3013	can_events => 1,
2302	%arg,	3014	%arg,
2303	);	3015	);
2304		3016
2305	$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");
2306	$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);
2307	$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");
2308		3020
2309	$self	3021	$self
2310	}	3022	}
2311		3023
2312	sub set_fontsize {	3024	sub set_fontsize {
…		…
2333	$self->{value}->set_text ($val);	3045	$self->{value}->set_text ($val);
2334	}	3046	}
2335		3047
2336	#############################################################################	3048	#############################################################################
2337		3049
2338	package CFClient::UI::Slider;	3050	package DC::UI::Slider;
2339		3051
2340	use strict;	3052	use strict;
2341		3053
2342	use CFClient::OpenGL;	3054	use DC::OpenGL;
2343		3055
2344	our @ISA = CFClient::UI::DrawBG::;	3056	our @ISA = DC::UI::DrawBG::;
2345		3057
2346	my @tex =	3058	my @tex =
2347	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	3059	map { new_from_resource DC::Texture $_ }
2348	qw(s1_slider.png s1_slider_bg.png);	3060	qw(s1_slider.png s1_slider_bg.png);
2349		3061
2350	sub new {	3062	sub new {
2351	my $class = shift;	3063	my $class = shift;
2352		3064
…		…
2389	sub set_value {	3101	sub set_value {
2390	my ($self, $value) = @_;	3102	my ($self, $value) = @_;
2391		3103
2392	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};	3104	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2393		3105
2394	$hi = $lo + 1 if $hi <= $lo;	3106	$hi = $lo if $hi < $lo;
2395		3107
2396	$page = $hi - $lo if $page > $hi - $lo;	3108	$value = $hi - $page if $value > $hi - $page;
2397
2398	$value = $lo if $value < $lo;	3109	$value = $lo if $value < $lo;
2399	$value = $hi - $page if $value > $hi - $page;
2400		3110
2401	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit	3111	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2402	if $unit;	3112	if $unit;
2403		3113
2404	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	3114	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
…		…
2420		3130
2421	$self->SUPER::invoke_button_down ($ev, $x, $y);	3131	$self->SUPER::invoke_button_down ($ev, $x, $y);
2422		3132
2423	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	3133	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2424		3134
2425	$self->invoke_mouse_motion ($ev, $x, $y)	3135	$self->invoke_mouse_motion ($ev, $x, $y);
		3136
		3137	1
2426	}	3138	}
2427		3139
2428	sub invoke_mouse_motion {	3140	sub invoke_mouse_motion {
2429	my ($self, $ev, $x, $y) = @_;	3141	my ($self, $ev, $x, $y) = @_;
2430		3142
…		…
2441	}	3153	}
2442		3154
2443	1	3155	1
2444	}	3156	}
2445		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
2446	sub update {	3170	sub update {
2447	my ($self) = @_;	3171	my ($self) = @_;
2448		3172
2449	delete $self->{knob_w};	3173	delete $self->{knob_w};
2450	$self->SUPER::update;	3174	$self->SUPER::update;
…		…
2454	my ($self) = @_;	3178	my ($self) = @_;
2455		3179
2456	unless ($self->{knob_w}) {	3180	unless ($self->{knob_w}) {
2457	$self->set_value ($self->{range}[0]);	3181	$self->set_value ($self->{range}[0]);
2458		3182
2459	my ($value, $lo, $hi, $page) = @{$self->{range}};	3183	my ($value, $lo, $hi, $page, $unit) = @{$self->{range}};
2460	my $range = ($hi - $page - $lo) || 1e-100;	3184	my $range = ($hi - $page - $lo) || 1e-10;
2461		3185
2462	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};
2463		3187
2464	$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;
2465	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;	3189	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2466		3190
2467	$value = ($value - $lo) / $range;	3191	$value = ($value - $lo) / $range;
…		…
2497	glDisable GL_TEXTURE_2D;	3221	glDisable GL_TEXTURE_2D;
2498	}	3222	}
2499		3223
2500	#############################################################################	3224	#############################################################################
2501		3225
2502	package CFClient::UI::ValSlider;	3226	package DC::UI::ValSlider;
2503		3227
2504	our @ISA = CFClient::UI::HBox::;	3228	our @ISA = DC::UI::HBox::;
2505		3229
2506	sub new {	3230	sub new {
2507	my ($class, %arg) = @_;	3231	my ($class, %arg) = @_;
2508		3232
2509	my $range = delete $arg{range};	3233	my $range = delete $arg{range};
2510		3234
2511	my $self = $class->SUPER::new (	3235	my $self = $class->SUPER::new (
2512	slider => (new CFClient::UI::Slider expand => 1, range => $range),	3236	slider => (new DC::UI::Slider expand => 1, range => $range),
2513	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	3237	entry => (new DC::UI::Label text => "", template => delete $arg{template}),
2514	to_value => sub { shift },	3238	to_value => sub { shift },
2515	from_value => sub { shift },	3239	from_value => sub { shift },
2516	%arg,	3240	%arg,
2517	);	3241	);
2518		3242
…		…
2538	sub set_range { shift->{slider}->set_range (@_) }	3262	sub set_range { shift->{slider}->set_range (@_) }
2539	sub set_value { shift->{slider}->set_value (@_) }	3263	sub set_value { shift->{slider}->set_value (@_) }
2540		3264
2541	#############################################################################	3265	#############################################################################
2542		3266
2543	package CFClient::UI::TextScroller;	3267	package DC::UI::TextScroller;
2544		3268
2545	our @ISA = CFClient::UI::HBox::;	3269	our @ISA = DC::UI::HBox::;
2546		3270
2547	use CFClient::OpenGL;	3271	use DC::OpenGL;
2548		3272
2549	sub new {	3273	sub new {
2550	my $class = shift;	3274	my $class = shift;
2551		3275
2552	my $self = $class->SUPER::new (	3276	my $self = $class->SUPER::new (
2553	fontsize => 1,	3277	fontsize => 1,
2554	can_events => 0,	3278	can_events => 1,
2555	indent => 0,	3279	indent => 0,
2556	#font => default_font	3280	#font => default_font
2557	@_,	3281	@_,
2558		3282
2559	layout => (new CFClient::Layout 1),	3283	layout => (new DC::Layout),
2560	par => [],	3284	par => [],
		3285	max_par => 0,
2561	height => 0,	3286	height => 0,
2562	children => [	3287	children => [
2563	(new CFClient::UI::Empty expand => 1),	3288	(new DC::UI::Empty expand => 1),
2564	(new CFClient::UI::Slider vertical => 1),	3289	(new DC::UI::Slider vertical => 1),
2565	],	3290	],
2566	);	3291	);
2567		3292
2568	$self->{children}[1]->connect (changed => sub { $self->update });	3293	$self->{children}[1]->connect (changed => sub { $self->update });
2569		3294
…		…
2575		3300
2576	$self->{fontsize} = $fontsize;	3301	$self->{fontsize} = $fontsize;
2577	$self->reflow;	3302	$self->reflow;
2578	}	3303	}
2579		3304
2580	sub visible_children {	3305	sub size_request {
2581	my ($self) = @_;	3306	my ($self) = @_;
2582		3307
2583	@{$self->{children}}[0,1]	3308	my ($empty, $slider) = $self->visible_children;
		3309
		3310	local $self->{children} = [$empty, $slider];
		3311	$self->SUPER::size_request
2584	}	3312	}
2585		3313
2586	sub invoke_size_allocate {	3314	sub invoke_size_allocate {
2587	my ($self, $w, $h) = @_;	3315	my ($self, $w, $h) = @_;
2588		3316
…		…
2594	$self->{layout}->set_width ($empty->{w});	3322	$self->{layout}->set_width ($empty->{w});
2595	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	3323	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2596		3324
2597	$self->reflow;	3325	$self->reflow;
2598		3326
		3327	local $self->{children} = [$empty, $slider];
2599	$self->SUPER::invoke_size_allocate ($w, $h)	3328	$self->SUPER::invoke_size_allocate ($w, $h)
		3329	}
		3330
		3331	sub invoke_mouse_wheel {
		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
2600	}	3339	}
2601		3340
2602	sub get_layout {	3341	sub get_layout {
2603	my ($self, $para) = @_;	3342	my ($self, $para) = @_;
2604		3343
…		…
2611	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	3350	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2612	$layout->set_markup ($para->{markup});	3351	$layout->set_markup ($para->{markup});
2613		3352
2614	$layout->set_shapes (	3353	$layout->set_shapes (
2615	map	3354	map
2616	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),	3355	+(0, $_->baseline_shift + $_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
2617	@{$para->{widget}}	3356	@{$para->{widget}}
2618	);	3357	);
2619		3358
2620	$layout	3359	$layout
2621	}	3360	}
…		…
2630	sub set_offset {	3369	sub set_offset {
2631	my ($self, $offset) = @_;	3370	my ($self, $offset) = @_;
2632		3371
2633	# todo: base offset on lines or so, not on pixels	3372	# todo: base offset on lines or so, not on pixels
2634	$self->{children}[1]->set_value ($offset);	3373	$self->{children}[1]->set_value ($offset);
		3374	}
		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;
2635	}	3389	}
2636		3390
2637	sub clear {	3391	sub clear {
2638	my ($self) = @_;	3392	my ($self) = @_;
2639		3393
…		…
2644	$self->{height} = 0;	3398	$self->{height} = 0;
2645	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	3399	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2646	}	3400	}
2647		3401
2648	sub add_paragraph {	3402	sub add_paragraph {
2649	my ($self, $color, $para, $indent) = @_;	3403	my $self = shift;
2650		3404
2651	my ($text, @w) = ref $para ? @$para : $para;	3405	for my $para (@_) {
2652
2653	$para = {	3406	$para = {
		3407	fg => [1, 1, 1, 1],
		3408	indent => 0,
		3409	markup => "",
		3410	widget => [],
		3411	ref $para ? %$para : (markup => $para),
2654	w => 1e10,	3412	w => 1e10,
2655	wrapped => 1,	3413	wrapped => 1,
2656	fg => $color,
2657	indent => $indent,
2658	markup => $text,
2659	widget => \@w,
2660	};	3414	};
2661		3415
2662	$self->add (@w) if @w;	3416	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
2663	push @{$self->{par}}, $para;	3417	push @{$self->{par}}, $para;
		3418	}
		3419
		3420	if (my $max = $self->{max_par}) {
		3421	shift @{$self->{par}} while @{$self->{par}} > $max;
		3422	}
2664		3423
2665	$self->{need_reflow}++;	3424	$self->{need_reflow}++;
2666	$self->update;	3425	$self->update;
2667	}	3426	}
2668		3427
2669	sub scroll_to_bottom {	3428	sub scroll_to_bottom {
2670	my ($self) = @_;	3429	my ($self) = @_;
2671		3430
2672	$self->{scroll_to_bottom} = 1;	3431	$self->{scroll_to} = $#{$self->{par}};
2673	$self->update;	3432	$self->update;
2674	}	3433	}
2675		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
		3457	$self->{height} = $height;
		3458	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
		3459
		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	}
		3466	}
		3467
2676	sub update {	3468	sub update {
2677	my ($self) = @_;	3469	my ($self) = @_;
2678		3470
2679	$self->SUPER::update;	3471	$self->SUPER::update;
2680		3472
2681	return unless $self->{h} > 0;	3473	return unless $self->{h} > 0;
2682		3474
2683	delete $self->{texture};	3475	delete $self->{texture};
2684		3476
2685	$ROOT->on_post_alloc ($self => sub {	3477	$ROOT->on_post_alloc ($self => sub {
		3478	$self->force_uptodate;
		3479
2686	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3480	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2687		3481
2688	if (delete $self->{need_reflow}) {
2689	my $height = 0;
2690
2691	for my $para (@{$self->{par}}) {
2692	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2693	my $layout = $self->get_layout ($para);
2694	my ($w, $h) = $layout->size;
2695
2696	$para->{w} = $w + $para->{indent};
2697	$para->{h} = $h;
2698	$para->{wrapped} = $layout->has_wrapped;
2699	}
2700
2701	$height += $para->{h};
2702	}
2703
2704	$self->{height} = $height;
2705
2706	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2707
2708	delete $self->{texture};
2709	}
2710
2711	if (delete $self->{scroll_to_bottom}) {
2712	$self->{children}[1]->set_value (1e10);
2713	}
2714
2715	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	3482	$self->{texture} ||= new_from_opengl DC::Texture $W, $H, sub {
2716	glClearColor 0, 0, 0, 0;	3483	glClearColor 0, 0, 0, 0;
2717	glClear GL_COLOR_BUFFER_BIT;	3484	glClear GL_COLOR_BUFFER_BIT;
2718		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;
2719	my $top = int $self->{children}[1]{range}[0];	3494	my $top = int $self->{children}[1]{range}[0];
2720		3495
2721	my $y0 = $top;	3496	my $y0 = $top;
2722	my $y1 = $top + $H;	3497	my $y1 = $top + $H;
2723		3498
2724	my $y = 0;
2725
2726	glEnable GL_BLEND;
2727	#TODO# not correct in windows where rgba is forced off
2728	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2729
2730	for my $para (@{$self->{par}}) {	3499	for my $para (@{$self->{par}}) {
2731	my $h = $para->{h};	3500	my $h = $para->{h};
		3501	my $y = $para->{y};
2732		3502
2733	if ($y0 < $y + $h && $y < $y1) {	3503	if ($y0 < $y + $h && $y < $y1) {
2734
2735	my $layout = $self->get_layout ($para);	3504	my $layout = $self->get_layout ($para);
2736		3505
2737	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2738
2739	glRasterPos $para->{indent}, $y - $y0;	3506	$layout->render ($para->{indent}, $y - $y0);
2740	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	3507	$layout->draw;
2741		3508
2742	if (my @w = @{ $para->{widget} }) {	3509	if (my @w = @{ $para->{widget} }) {
2743	my @s = $layout->get_shapes;	3510	my @s = $layout->get_shapes;
2744		3511
2745	for (@w) {	3512	for (@w) {
…		…
2751	$_->draw;	3518	$_->draw;
2752	}	3519	}
2753	}	3520	}
2754	}	3521	}
2755		3522
2756	$y += $h;	3523	$paridx++;
		3524	$top_paragraph ||= $paridx if $y >= $top;
2757	}	3525	}
2758		3526
2759	glDisable GL_BLEND;	3527	$self->{top_paragraph} = $top_paragraph;
2760	};	3528	};
2761	});	3529	});
2762	}	3530	}
2763		3531
2764	sub reconfigure {	3532	sub reconfigure {
…		…
2782	$self->{children}[1]->draw;	3550	$self->{children}[1]->draw;
2783	}	3551	}
2784		3552
2785	#############################################################################	3553	#############################################################################
2786		3554
2787	package CFClient::UI::Animator;	3555	package DC::UI::Animator;
2788		3556
2789	use CFClient::OpenGL;	3557	use DC::OpenGL;
2790		3558
2791	our @ISA = CFClient::UI::Bin::;	3559	our @ISA = DC::UI::Bin::;
2792		3560
2793	sub moveto {	3561	sub moveto {
2794	my ($self, $x, $y) = @_;	3562	my ($self, $x, $y) = @_;
2795		3563
2796	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3564	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2824	glPopMatrix;	3592	glPopMatrix;
2825	}	3593	}
2826		3594
2827	#############################################################################	3595	#############################################################################
2828		3596
2829	package CFClient::UI::Flopper;	3597	package DC::UI::Flopper;
2830		3598
2831	our @ISA = CFClient::UI::Button::;	3599	our @ISA = DC::UI::Button::;
2832		3600
2833	sub new {	3601	sub new {
2834	my $class = shift;	3602	my $class = shift;
2835		3603
2836	my $self = $class->SUPER::new (	3604	my $self = $class->SUPER::new (
…		…
2848	$self->{other}->toggle_visibility;	3616	$self->{other}->toggle_visibility;
2849	}	3617	}
2850		3618
2851	#############################################################################	3619	#############################################################################
2852		3620
2853	package CFClient::UI::Tooltip;	3621	package DC::UI::Tooltip;
2854		3622
2855	our @ISA = CFClient::UI::Bin::;	3623	our @ISA = DC::UI::Bin::;
2856		3624
2857	use CFClient::OpenGL;	3625	use DC::OpenGL;
2858		3626
2859	sub new {	3627	sub new {
2860	my $class = shift;	3628	my $class = shift;
2861		3629
2862	$class->SUPER::new (	3630	$class->SUPER::new (
…		…
2866	}	3634	}
2867		3635
2868	sub set_tooltip_from {	3636	sub set_tooltip_from {
2869	my ($self, $widget) = @_;	3637	my ($self, $widget) = @_;
2870		3638
2871	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 =~ /^#(.*)$/;
2872		3644
2873	if ($ENV{CFPLUS_DEBUG} & 2) {	3645	if ($ENV{CFPLUS_DEBUG} & 2) {
2874	$tooltip .= "\n\n" . (ref $widget) . "\n"	3646	$tip .= "\n\n" . (ref $widget) . "\n"
2875	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	3647	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2876	. "req $widget->{req_w} $widget->{req_h}\n"	3648	. "req $widget->{req_w} $widget->{req_h}\n"
2877	. "visible $widget->{visible}";	3649	. "visible $widget->{visible}";
2878	}	3650	}
2879		3651
2880	$tooltip =~ s/^\n+//;	3652	$tip =~ s/^\n+//;
2881	$tooltip =~ s/\n+$//;	3653	$tip =~ s/\n+$//;
2882		3654
2883	$self->add (new CFClient::UI::Label	3655	$self->add (new DC::UI::Label
		3656	fg => $DC::THEME{tooltip_fg},
2884	markup => $tooltip,	3657	markup => $tip,
2885	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3658	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
		3659	align => 0,
2886	fontsize => 0.8,	3660	fontsize => 0.8,
2887	fg => [0, 0, 0, 1],	3661	style => $DC::THEME{tooltip_style}, # FLAG_INVERSE
2888	ellipsise => 0,	3662	ellipsise => 0,
2889	font => ($widget->{tooltip_font} || $::FONT_PROP),	3663	font => ($widget->{tooltip_font} || $::FONT_PROP),
2890	);	3664	);
2891	}	3665	}
2892		3666
…		…
2911		3685
2912	$self->{root}->on_post_alloc ("move_$self" => sub {	3686	$self->{root}->on_post_alloc ("move_$self" => sub {
2913	my $widget = $self->{owner}	3687	my $widget = $self->{owner}
2914	or return;	3688	or return;
2915		3689
		3690	if ($widget->{visible}) {
2916	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3691	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2917		3692
2918	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3693	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2919	if $x + $self->{w} > $self->{root}{w};	3694	if $x + $self->{w} > $self->{root}{w};
2920		3695
2921	$self->move_abs ($x, $y);	3696	$self->move_abs ($x, $y);
		3697	} else {
		3698	$self->hide;
		3699	}
2922	});	3700	});
2923	}	3701	}
2924		3702
2925	sub _draw {	3703	sub _draw {
2926	my ($self) = @_;	3704	my ($self) = @_;
2927		3705
2928	glTranslate 0.375, 0.375;
2929
2930	my ($w, $h) = @$self{qw(w h)};	3706	my ($w, $h) = @$self{qw(w h)};
2931		3707
2932	glColor 1, 0.8, 0.4;	3708	glColor @{ $DC::THEME{tooltip_bg} };
2933	glBegin GL_QUADS;	3709	glRect 0, 0, $w, $h;
2934	glVertex 0 , 0;
2935	glVertex 0 , $h;
2936	glVertex $w, $h;
2937	glVertex $w, 0;
2938	glEnd;
2939		3710
2940	glColor 0, 0, 0;	3711	glColor @{ $DC::THEME{tooltip_border} };
2941	glBegin GL_LINE_LOOP;	3712	glRect_lineloop .5, .5, $w + .5, $h + .5;
2942	glVertex 0 , 0;
2943	glVertex 0 , $h;
2944	glVertex $w, $h;
2945	glVertex $w, 0;
2946	glEnd;
2947		3713
2948	glTranslate 2 - 0.375, 2 - 0.375;	3714	glTranslate 2, 2;
2949		3715
2950	$self->SUPER::_draw;	3716	$self->SUPER::_draw;
2951	}	3717	}
2952		3718
2953	#############################################################################	3719	#############################################################################
2954		3720
2955	package CFClient::UI::Face;	3721	package DC::UI::Face;
2956		3722
2957	our @ISA = CFClient::UI::Base::;	3723	our @ISA = DC::UI::DrawBG::;
2958		3724
2959	use CFClient::OpenGL;	3725	use DC::OpenGL;
2960		3726
2961	sub new {	3727	sub new {
2962	my $class = shift;	3728	my $class = shift;
2963		3729
2964	my $self = $class->SUPER::new (	3730	my $self = $class->SUPER::new (
		3731	size_w => 32,
		3732	size_h => 8,
2965	aspect => 1,	3733	aspect => 1,
2966	can_events => 0,	3734	can_events => 0,
2967	@_,	3735	@_,
2968	);	3736	);
2969		3737
2970	if ($self->{anim} && $self->{animspeed}) {	3738	$self->update_anim;
2971	Scalar::Util::weaken (my $widget = $self);
2972
2973	$self->{timer} = Event->timer (
2974	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2975	hard => 1,
2976	interval => $self->{animspeed},
2977	cb => sub {
2978	++$widget->{frame};
2979	$widget->update;
2980	},
2981	);
2982	}
2983		3739
2984	$self	3740	$self
2985	}	3741	}
2986		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
2987	sub size_request {	3802	sub size_request {
2988	(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)
2989	}	3820	}
2990		3821
2991	sub update {	3822	sub update {
2992	my ($self) = @_;	3823	my ($self) = @_;
2993		3824
2994	return unless $self->{visible};	3825	return unless $self->{visible};
2995		3826
2996	$self->SUPER::update;	3827	$self->SUPER::update;
2997	}	3828	}
2998		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
2999	sub _draw {	3859	sub _draw {
3000	my ($self) = @_;	3860	my ($self) = @_;
3001		3861
3002	return unless $::CONN;	3862	$self->SUPER::_draw;
3003		3863
3004	my $face;	3864	if (my $tex = $self->{tex}) {
3005
3006	if ($self->{frame}) {
3007	my $anim = $::CONN->{anim}[$self->{anim}];
3008
3009	$face = $anim->[ $self->{frame} % @$anim ]
3010	if $anim && @$anim;
3011	}
3012
3013	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
3014
3015	if ($tex) {
3016	glEnable GL_TEXTURE_2D;	3865	glEnable GL_TEXTURE_2D;
3017	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3866	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
3018	glColor 0, 0, 0, 1;	3867	glColor 0, 0, 0, 1;
3019	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3868	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
3020	glDisable GL_TEXTURE_2D;	3869	glDisable GL_TEXTURE_2D;
…		…
3022	}	3871	}
3023		3872
3024	sub destroy {	3873	sub destroy {
3025	my ($self) = @_;	3874	my ($self) = @_;
3026		3875
3027	$self->{timer}->cancel	3876	(delete $self->{timer})->cancel
3028	if $self->{timer};	3877	if $self->{timer};
3029		3878
3030	$self->SUPER::destroy;	3879	$self->SUPER::destroy;
3031	}	3880	}
3032		3881
3033	#############################################################################	3882	#############################################################################
3034		3883
3035	package CFClient::UI::Buttonbar;	3884	package DC::UI::Buttonbar;
3036		3885
3037	our @ISA = CFClient::UI::HBox::;	3886	our @ISA = DC::UI::HBox::;
3038		3887
3039	# TODO: should actualyl wrap buttons and other goodies.	3888	# TODO: should actually wrap buttons and other goodies.
3040		3889
3041	#############################################################################	3890	#############################################################################
3042		3891
3043	package CFClient::UI::Menu;	3892	package DC::UI::Menu;
3044		3893
3045	our @ISA = CFClient::UI::FancyFrame::;	3894	our @ISA = DC::UI::Toplevel::;
3046		3895
3047	use CFClient::OpenGL;	3896	use DC::OpenGL;
3048		3897
3049	sub new {	3898	sub new {
3050	my $class = shift;	3899	my $class = shift;
3051		3900
3052	my $self = $class->SUPER::new (	3901	my $self = $class->SUPER::new (
3053	items => [],	3902	items => [],
3054	z => 100,	3903	z => 100,
3055	@_,	3904	@_,
3056	);	3905	);
3057		3906
3058	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3907	$self->add ($self->{vbox} = new DC::UI::VBox);
3059		3908
3060	for my $item (@{ $self->{items} }) {	3909	for my $item (@{ $self->{items} }) {
3061	my ($widget, $cb, $tooltip) = @$item;	3910	my ($widget, $cb, $tooltip) = @$item;
3062		3911
3063	# handle various types of items, only text for now	3912	# handle various types of items, only text for now
3064	if (!ref $widget) {	3913	if (!ref $widget) {
		3914	if ($widget =~ /\t/) {
		3915	my ($left, $right) = split /\t/, $widget, 2;
		3916
3065	$widget = new CFClient::UI::Label	3917	$widget = new DC::UI::HBox
3066	can_hover => 1,	3918	can_hover => 1,
3067	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,
3068	markup => $widget,	3932	markup => $widget,
3069	tooltip => $tooltip	3933	tooltip => $tooltip;
		3934	}
3070	}	3935	}
3071		3936
3072	$self->{item}{$widget} = $item;	3937	$self->{item}{$widget} = $item;
3073		3938
3074	$self->{vbox}->add ($widget);	3939	$self->{vbox}->add ($widget);
…		…
3086	# maybe save $GRAB? must be careful about events...	3951	# maybe save $GRAB? must be careful about events...
3087	$GRAB = $self;	3952	$GRAB = $self;
3088	$self->{button} = $ev->{button};	3953	$self->{button} = $ev->{button};
3089		3954
3090	$self->show;	3955	$self->show;
3091	$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
3092	}	3965	}
3093		3966
3094	sub invoke_mouse_motion {	3967	sub invoke_mouse_motion {
3095	my ($self, $ev, $x, $y) = @_;	3968	my ($self, $ev, $x, $y) = @_;
3096		3969
…		…
3117	1	3990	1
3118	}	3991	}
3119		3992
3120	#############################################################################	3993	#############################################################################
3121		3994
3122	package CFClient::UI::Multiplexer;	3995	package DC::UI::Multiplexer;
3123		3996
3124	our @ISA = CFClient::UI::Container::;	3997	our @ISA = DC::UI::Container::;
3125		3998
3126	sub new {	3999	sub new {
3127	my $class = shift;	4000	my $class = shift;
3128		4001
3129	my $self = $class->SUPER::new (	4002	my $self = $class->SUPER::new (
3130	@_,	4003	@_,
3131	);	4004	);
3132		4005
3133	$self->{current} = $self->{children}[0]	4006	$self->set_current_page (0);
3134	if @{ $self->{children} };
3135		4007
3136	$self	4008	$self
3137	}	4009	}
3138		4010
3139	sub add {	4011	sub add {
3140	my ($self, @widgets) = @_;	4012	my ($self, @widgets) = @_;
3141		4013
3142	$self->SUPER::add (@widgets);	4014	$self->SUPER::add (@widgets);
3143		4015
3144	$self->{current} = $self->{children}[0]	4016	$self->set_current_page (0)
3145	if @{ $self->{children} };	4017	if @widgets == @{ $self->{children} };
		4018	}
		4019
		4020	sub get_current_page {
		4021	my ($self) = @_;
		4022
		4023	$self->{current}
3146	}	4024	}
3147		4025
3148	sub set_current_page {	4026	sub set_current_page {
3149	my ($self, $page_or_widget) = @_;	4027	my ($self, $page_or_widget) = @_;
3150		4028
3151	my $widget = ref $page_or_widget	4029	my $widget = ref $page_or_widget
3152	? $page_or_widget	4030	? $page_or_widget
3153	: $self->{children}[$page_or_widget];	4031	: $self->{children}[$page_or_widget];
3154		4032
		4033	$self->{current}->set_invisible if $self->{current} && $self->{visible};
		4034
3155	$self->{current} = $widget;	4035	if (($self->{current} = $widget)) {
		4036	$self->{current}->set_visible if $self->{current} && $self->{visible};
3156	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	4037	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3157		4038
3158	$self->emit (page_changed => $self->{current});	4039	$self->emit (page_changed => $self->{current});
		4040	}
3159		4041
3160	$self->realloc;	4042	$self->realloc;
3161	}	4043	}
3162		4044
3163	sub visible_children {	4045	sub visible_children {
3164	$_[0]{current}	4046	$_[0]{current} || ()
3165	}	4047	}
3166		4048
3167	sub size_request {	4049	sub size_request {
3168	my ($self) = @_;	4050	my ($self) = @_;
3169		4051
		4052	$self->{current}
3170	$self->{current}->size_request	4053	? $self->{current}->size_request
		4054	: (0, 0)
3171	}	4055	}
3172		4056
3173	sub invoke_size_allocate {	4057	sub invoke_size_allocate {
3174	my ($self, $w, $h) = @_;	4058	my ($self, $w, $h) = @_;
3175		4059
3176	$self->{current}->configure (0, 0, $w, $h);	4060	$self->{current}->configure (0, 0, $w, $h)
		4061	if $self->{current};
3177		4062
3178	1	4063	1
3179	}	4064	}
3180		4065
3181	sub _draw {	4066	sub _draw {
3182	my ($self) = @_;	4067	my ($self) = @_;
3183		4068
3184	$self->{current}->draw;	4069	$self->{current}->draw
		4070	if $self->{current};
3185	}	4071	}
3186		4072
3187	#############################################################################	4073	#############################################################################
3188		4074
3189	package CFClient::UI::Notebook;	4075	package DC::UI::Notebook;
3190		4076
		4077	use DC::OpenGL;
		4078
3191	our @ISA = CFClient::UI::VBox::;	4079	our @ISA = DC::UI::VBox::;
3192		4080
3193	sub new {	4081	sub new {
3194	my $class = shift;	4082	my $class = shift;
3195		4083
3196	my $self = $class->SUPER::new (	4084	my $self = $class->SUPER::new (
3197	buttonbar => (new CFClient::UI::Buttonbar),	4085	buttonbar => (new DC::UI::Buttonbar),
3198	multiplexer => (new CFClient::UI::Multiplexer expand => 1),	4086	multiplexer => (new DC::UI::Multiplexer expand => 1),
		4087	active_outline => [.7, .7, 0.2],
3199	# filter => # will be put between multiplexer and $self	4088	# filter => # will be put between multiplexer and $self
3200	@_,	4089	@_,
3201	);	4090	);
3202		4091
3203	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};	4092	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3204	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});	4093	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
3205		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
3206	$self	4129	$self
3207	}	4130	}
3208		4131
3209	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 {
3210	my ($self, $title, $widget, $tooltip) = @_;	4162	my ($self, $title, $widget, $tooltip) = @_;
3211		4163
3212	Scalar::Util::weaken $self;	4164	$title = [$title, $tooltip] unless ref $title;
		4165	$widget->{c_tab} = $title;
3213		4166
3214	$self->{buttonbar}->add (new CFClient::UI::Button
3215	markup => $title,
3216	tooltip => $tooltip,
3217	on_activate => sub { $self->set_current_page ($widget) },
3218	);
3219
3220	$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
3221	}	4174	}
3222		4175
3223	sub set_current_page {	4176	sub set_current_page {
3224	my ($self, $page) = @_;	4177	my ($self, $page) = @_;
3225		4178
3226	$self->{multiplexer}->set_current_page ($page);	4179	$self->{multiplexer}->set_current_page ($page);
3227	$self->emit (page_changed => $self->{multiplexer}{current});	4180	$self->emit (page_changed => $self->{multiplexer}{current});
3228	}	4181	}
3229		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
3230	#############################################################################	4203	#############################################################################
3231		4204
3232	package CFClient::UI::Combobox;	4205	package DC::UI::Selector;
3233		4206
3234	use utf8;	4207	use utf8;
3235		4208
3236	our @ISA = CFClient::UI::Button::;	4209	our @ISA = DC::UI::Button::;
3237		4210
3238	sub new {	4211	sub new {
3239	my $class = shift;	4212	my $class = shift;
3240		4213
3241	my $self = $class->SUPER::new (	4214	my $self = $class->SUPER::new (
…		…
3258	my ($value, $title, $tooltip) = @$_;	4231	my ($value, $title, $tooltip) = @$_;
3259		4232
3260	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];	4233	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3261	}	4234	}
3262		4235
3263	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);	4236	DC::UI::Menu->new (items => \@menu_items)->popup ($ev);
3264	}	4237	}
3265		4238
3266	sub _set_value {	4239	sub _set_value {
3267	my ($self, $value) = @_;	4240	my ($self, $value) = @_;
3268		4241
3269	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }	4242	my ($item) = grep $_->[0] eq $value, @{ $self->{options} };
		4243	$item ||= $self->{options}[0]
3270	or return;	4244	or return;
3271		4245
3272	$self->{value} = $item->[0];	4246	$self->{value} = $item->[0];
3273	$self->set_markup ("$item->[1] ⇓");	4247	$self->set_markup ("$item->[1] ⇓");
3274	$self->set_tooltip ($item->[2]);	4248	# $self->set_tooltip ($item->[2]);
3275	}	4249	}
3276		4250
3277	sub set_value {	4251	sub set_value {
3278	my ($self, $value) = @_;	4252	my ($self, $value) = @_;
3279		4253
…		…
3281		4255
3282	$self->_set_value ($value);	4256	$self->_set_value ($value);
3283	$self->emit (changed => $value);	4257	$self->emit (changed => $value);
3284	}	4258	}
3285		4259
		4260	sub set_options {
		4261	my ($self, $options) = @_;
		4262
		4263	$self->{options} = $options;
		4264	$self->_set_value ($self->{value});
		4265	}
		4266
3286	#############################################################################	4267	#############################################################################
3287		4268
3288	package CFClient::UI::Statusbox;	4269	package DC::UI::Statusbox;
3289		4270
3290	our @ISA = CFClient::UI::VBox::;	4271	our @ISA = DC::UI::VBox::;
3291		4272
3292	sub new {	4273	sub new {
3293	my $class = shift;	4274	my $class = shift;
3294		4275
3295	my $self = $class->SUPER::new (	4276	my $self = $class->SUPER::new (
3296	fontsize => 0.8,	4277	fontsize => 0.8,
3297	@_,	4278	@_,
3298	);	4279	);
3299		4280
3300	Scalar::Util::weaken (my $this = $self);	4281	DC::weaken (my $this = $self);
3301		4282
3302	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });	4283	$self->{timer} = EV::timer 1, 1, sub { $this->reorder };
3303		4284
3304	$self	4285	$self
3305	}	4286	}
3306		4287
3307	sub reorder {	4288	sub reorder {
3308	my ($self) = @_;	4289	my ($self) = @_;
3309	my $NOW = Time::HiRes::time;	4290	my $NOW = EV::time;
3310		4291
3311	# freeze display when hovering over any label	4292	# freeze display when hovering over any label
3312	return if $CFClient::UI::TOOLTIP->{owner}	4293	return if $DC::UI::TOOLTIP->{owner}
3313	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},	4294	&& grep $DC::UI::TOOLTIP->{owner} == $_->{label},
3314	values %{ $self->{item} };	4295	values %{ $self->{item} };
3315		4296
3316	while (my ($k, $v) = each %{ $self->{item} }) {	4297	while (my ($k, $v) = each %{ $self->{item} }) {
3317	delete $self->{item}{$k} if $v->{timeout} < $NOW;	4298	delete $self->{item}{$k} if $v->{timeout} < $NOW;
3318	}	4299	}
		4300
		4301	$self->{timer}->set (1, 1);
3319		4302
3320	my @widgets;	4303	my @widgets;
3321		4304
3322	my @items = sort {	4305	my @items = sort {
3323	$a->{pri} <=> $b->{pri}	4306	$a->{pri} <=> $b->{pri}
3324	or $b->{id} <=> $a->{id}	4307	or $b->{id} <=> $a->{id}
3325	} values %{ $self->{item} };	4308	} values %{ $self->{item} };
3326
3327	$self->{timer}->interval (1);
3328		4309
3329	my $count = 10 + 1;	4310	my $count = 10 + 1;
3330	for my $item (@items) {	4311	for my $item (@items) {
3331	last unless --$count;	4312	last unless --$count;
3332		4313
…		…
3339	for ($short) {	4320	for ($short) {
3340	s/^\s+//;	4321	s/^\s+//;
3341	s/\s+/ /g;	4322	s/\s+/ /g;
3342	}	4323	}
3343		4324
3344	new CFClient::UI::Label	4325	new DC::UI::Label
3345	markup => $short,	4326	markup => $short,
3346	tooltip => $item->{tooltip},	4327	tooltip => $item->{tooltip},
3347	tooltip_font => $::FONT_PROP,	4328	tooltip_font => $::FONT_PROP,
3348	tooltip_width => 0.67,	4329	tooltip_width => 0.67,
3349	fontsize => $item->{fontsize} || $self->{fontsize},	4330	fontsize => $item->{fontsize} || $self->{fontsize},
3350	max_w => $::WIDTH * 0.44,	4331	max_w => $::WIDTH * 0.44,
		4332	align => 0,
3351	fg => [@{ $item->{fg} }],	4333	fg => [@{ $item->{fg} }],
3352	can_events => 1,	4334	can_events => 1,
3353	can_hover => 1	4335	can_hover => 1
3354	};	4336	};
3355		4337
3356	if ((my $diff = $item->{timeout} - $NOW) < 2) {	4338	if ((my $diff = $item->{timeout} - $NOW) < 2) {
3357	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;	4339	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
3358	$label->update;	4340	$label->update;
3359	$label->set_max_size (undef, $label->{req_h} * $diff)	4341	$label->set_max_size (undef, $label->{req_h} * $diff)
3360	if $diff < 1;	4342	if $diff < 1;
3361	$self->{timer}->interval (1/30);	4343	$self->{timer}->set (1/30, 1/30);
3362	} else {	4344	} else {
3363	$label->{fg}[3] = $item->{fg}[3] || 1;	4345	$label->{fg}[3] = $item->{fg}[3] || 1;
3364	}	4346	}
3365		4347
3366	push @widgets, $label;	4348	push @widgets, $label;
3367	}	4349	}
		4350
		4351	my $hash = join ",", @widgets;
		4352	return if $hash eq $self->{last_widget_hash};
		4353	$self->{last_widget_hash} = $hash;
3368		4354
3369	$self->clear;	4355	$self->clear;
3370	$self->SUPER::add (reverse @widgets);	4356	$self->SUPER::add (reverse @widgets);
3371	}	4357	}
3372		4358
…		…
3403	count => 1,	4389	count => 1,
3404	%arg,	4390	%arg,
3405	};	4391	};
3406	}	4392	}
3407		4393
		4394	$ROOT->on_refresh (reorder => sub {
3408	$self->reorder;	4395	$self->reorder;
		4396	});
3409	}	4397	}
3410		4398
3411	sub reconfigure {	4399	sub reconfigure {
3412	my ($self) = @_;	4400	my ($self) = @_;
3413		4401
…		…
3426	$self->SUPER::destroy;	4414	$self->SUPER::destroy;
3427	}	4415	}
3428		4416
3429	#############################################################################	4417	#############################################################################
3430		4418
3431	package CFClient::UI::Inventory;
3432
3433	our @ISA = CFClient::UI::ScrolledWindow::;
3434
3435	sub new {
3436	my $class = shift;
3437
3438	my $self = $class->SUPER::new (
3439	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3440	@_,
3441	);
3442
3443	$self
3444	}
3445
3446	sub set_items {
3447	my ($self, $items) = @_;
3448
3449	$self->{child}->clear;
3450	return unless $items;
3451
3452	my @items = sort {
3453	($a->{type} <=> $b->{type})
3454	or ($a->{name} cmp $b->{name})
3455	} @$items;
3456
3457	$self->{real_items} = \@items;
3458
3459	my $row = 0;
3460	for my $item (@items) {
3461	CFClient::Item::update_widgets $item;
3462
3463	$self->{child}->add (0, $row, $item->{face_widget});
3464	$self->{child}->add (1, $row, $item->{desc_widget});
3465	$self->{child}->add (2, $row, $item->{weight_widget});
3466
3467	$row++;
3468	}
3469	}
3470
3471	#############################################################################
3472
3473	package CFClient::UI::BindEditor;
3474
3475	our @ISA = CFClient::UI::FancyFrame::;
3476
3477	sub new {
3478	my $class = shift;
3479
3480	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3481
3482	$self->add (my $vb = new CFClient::UI::VBox);
3483
3484
3485	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3486	text => "start recording",
3487	tooltip => "Start/Stops recording of actions."
3488	."All subsequent actions after the recording started will be captured."
3489	."The actions are displayed after the record was stopped."
3490	."To bind the action you have to click on the 'Bind' button",
3491	on_activate => sub {
3492	unless ($self->{recording}) {
3493	$self->start;
3494	} else {
3495	$self->stop;
3496	}
3497	});
3498
3499	$vb->add (new CFClient::UI::Label text => "Actions:");
3500	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3501
3502	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3503	$vb->add (my $hb = new CFClient::UI::HBox);
3504	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3505	$hb->add (new CFClient::UI::Button
3506	text => "bind",
3507	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3508	on_activate => sub {
3509	$self->ask_for_bind;
3510	});
3511
3512	$vb->add (my $hb = new CFClient::UI::HBox);
3513	$hb->add (new CFClient::UI::Button
3514	text => "ok",
3515	expand => 1,
3516	tooltip => "This closes the binding editor and saves the binding",
3517	on_activate => sub {
3518	$self->hide;
3519	$self->commit;
3520	});
3521
3522	$hb->add (new CFClient::UI::Button
3523	text => "cancel",
3524	expand => 1,
3525	tooltip => "This closes the binding editor without saving",
3526	on_activate => sub {
3527	$self->hide;
3528	$self->{binding_cancel}->()
3529	if $self->{binding_cancel};
3530	});
3531
3532	$self->update_binding_widgets;
3533
3534	$self
3535	}
3536
3537	sub cfg_bind {
3538	my ($self, $mod, $sym, $cmds) = @_;
3539	$::CFG->{profile}{default}{bindings}{$mod}{$sym} = $cmds;
3540	::update_bindings ();
3541	}
3542
3543	sub cfg_unbind {
3544	my ($self, $mod, $sym, $cmds) = @_;
3545	delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
3546	::update_bindings ();
3547	}
3548
3549	sub commit {
3550	my ($self) = @_;
3551	my ($mod, $sym, $cmds) = $self->get_binding;
3552	if ($sym != 0 && @$cmds > 0) {
3553	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3554	."'. Don't forget 'Save Config'!");
3555	$self->{binding_change}->($mod, $sym, $cmds)
3556	if $self->{binding_change};
3557	} else {
3558	$::STATUSBOX->add ("No action bound, no key or action specified!");
3559	$self->{binding_cancel}->()
3560	if $self->{binding_cancel};
3561	}
3562	}
3563
3564	sub start {
3565	my ($self) = @_;
3566
3567	$self->{rec_btn}->set_text ("stop recording");
3568	$self->{recording} = 1;
3569	$self->clear_command_list;
3570	$::CONN->start_record if $::CONN;
3571	}
3572
3573	sub stop {
3574	my ($self) = @_;
3575
3576	$self->{rec_btn}->set_text ("start recording");
3577	$self->{recording} = 0;
3578
3579	my $rec;
3580	$rec = $::CONN->stop_record if $::CONN;
3581	return unless ref $rec eq 'ARRAY';
3582	$self->set_command_list ($rec);
3583	}
3584
3585
3586	sub ask_for_bind_and_commit {
3587	my ($self) = @_;
3588	$self->ask_for_bind (1);
3589	}
3590
3591	sub ask_for_bind {
3592	my ($self, $commit, $end_cb) = @_;
3593
3594	CFClient::Binder::open_binding_dialog (sub {
3595	my ($mod, $sym) = @_;
3596	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3597	$self->update_binding_widgets;
3598	$self->commit if $commit;
3599	$end_cb->() if $end_cb;
3600	});
3601	}
3602
3603	# $mod and $sym are the modifiers and key symbol
3604	# $cmds is a array ref of strings (the commands)
3605	# $cb is the callback that is executed on OK
3606	# $ccb is the callback that is executed on CANCEL and
3607	# when the binding was unsuccessful on OK
3608	sub set_binding {
3609	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3610
3611	$self->clear_command_list;
3612	$self->{recording} = 0;
3613	$self->{rec_btn}->set_text ("start recording");
3614
3615	$self->{binding} = [$mod, $sym];
3616	$self->{commands} = $cmds;
3617
3618	$self->{binding_change} = $cb;
3619	$self->{binding_cancel} = $ccb;
3620
3621	$self->update_binding_widgets;
3622	}
3623
3624	# this is a shortcut method that asks for a binding
3625	# and then just binds it.
3626	sub do_quick_binding {
3627	my ($self, $cmds, $end_cb) = @_;
3628	$self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
3629	$self->ask_for_bind (1, $end_cb);
3630	}
3631
3632	sub update_binding_widgets {
3633	my ($self) = @_;
3634	my ($mod, $sym, $cmds) = $self->get_binding;
3635	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3636	$self->set_command_list ($cmds);
3637	}
3638
3639	sub get_binding {
3640	my ($self) = @_;
3641	return (
3642	$self->{binding}->[0],
3643	$self->{binding}->[1],
3644	[ grep { defined $_ } @{$self->{commands}} ]
3645	);
3646	}
3647
3648	sub clear_command_list {
3649	my ($self) = @_;
3650	$self->{cmdbox}->clear ();
3651	}
3652
3653	sub set_command_list {
3654	my ($self, $cmds) = @_;
3655
3656	$self->{cmdbox}->clear ();
3657	$self->{commands} = $cmds;
3658
3659	my $idx = 0;
3660
3661	for (@$cmds) {
3662	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3663
3664	my $i = $idx;
3665	$hb->add (new CFClient::UI::Label text => $_);
3666	$hb->add (new CFClient::UI::Button
3667	text => "delete",
3668	tooltip => "Deletes the action from the record",
3669	on_activate => sub {
3670	$self->{cmdbox}->remove ($hb);
3671	$cmds->[$i] = undef;
3672	});
3673
3674
3675	$idx++
3676	}
3677	}
3678
3679	#############################################################################
3680
3681	package CFClient::UI::SpellList;
3682
3683	our @ISA = CFClient::UI::Table::;
3684
3685	sub new {
3686	my $class = shift;
3687
3688	my $self = $class->SUPER::new (
3689	binding => [],
3690	commands => [],
3691	@_,
3692	)
3693	}
3694
3695	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
3696
3697	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3698	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
3699	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3700	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
3701	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3702	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
3703	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3704	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
3705	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3706	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
3707
3708	sub rebuild_spell_list {
3709	my ($self) = @_;
3710
3711	$CFClient::UI::ROOT->on_refresh ($self => sub {
3712	$self->clear;
3713
3714	return unless $::CONN;
3715
3716	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3717	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3718	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3719	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3720	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3721
3722	my $row = 0;
3723
3724	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3725	my $spell = $self->{spell}{$_};
3726
3727	$row++;
3728
3729	my $spell_cb = sub {
3730	my ($widget, $ev) = @_;
3731
3732	if ($ev->{button} == 1) {
3733	$::CONN->user_send ("cast $spell->{name}");
3734	} elsif ($ev->{button} == 2) {
3735	$::CONN->user_send ("invoke $spell->{name}");
3736	} elsif ($ev->{button} == 3) {
3737	(new CFClient::UI::Menu
3738	items => [
3739	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3740	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3741	],
3742	)->popup ($ev);
3743	} else {
3744	return 0;
3745	}
3746
3747	1
3748	};
3749
3750	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
3751
3752	#TODO: add path info to tooltip
3753	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
3754
3755	$self->add (0, $row, new CFClient::UI::Face
3756	face => $spell->{face},
3757	can_hover => 1,
3758	can_events => 1,
3759	tooltip => $tooltip,
3760	on_button_down => $spell_cb,
3761	);
3762
3763	$self->add (1, $row, new CFClient::UI::Label
3764	expand => 1,
3765	text => $spell->{name},
3766	can_hover => 1,
3767	can_events => 1,
3768	tooltip => $tooltip,
3769	on_button_down => $spell_cb,
3770	);
3771
3772	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
3773	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3774	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3775	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3776	}
3777	});
3778	}
3779
3780	sub add_spell {
3781	my ($self, $spell) = @_;
3782
3783	$self->{spell}->{$spell->{name}} = $spell;
3784	$self->rebuild_spell_list;
3785	}
3786
3787	sub remove_spell {
3788	my ($self, $spell) = @_;
3789
3790	delete $self->{spell}->{$spell->{name}};
3791	$self->rebuild_spell_list;
3792	}
3793
3794	sub clear_spells {
3795	my ($self) = @_;
3796
3797	$self->{spell} = {};
3798	$self->rebuild_spell_list;
3799	}
3800
3801	#############################################################################
3802
3803	package CFClient::UI::Root;	4419	package DC::UI::Root;
3804		4420
3805	our @ISA = CFClient::UI::Container::;	4421	our @ISA = DC::UI::Container::;
3806		4422
3807	use List::Util qw(min max);	4423	use List::Util qw(min max);
3808		4424
3809	use CFClient::OpenGL;	4425	use DC::OpenGL;
3810		4426
3811	sub new {	4427	sub new {
3812	my $class = shift;	4428	my $class = shift;
3813		4429
3814	my $self = $class->SUPER::new (	4430	my $self = $class->SUPER::new (
3815	visible => 1,	4431	visible => 1,
3816	@_,	4432	@_,
3817	);	4433	);
3818		4434
3819	Scalar::Util::weaken ($self->{root} = $self);	4435	DC::weaken ($self->{root} = $self);
3820		4436
3821	$self	4437	$self
3822	}	4438	}
3823		4439
3824	sub size_request {	4440	sub size_request {
…		…
3872	}	4488	}
3873		4489
3874	sub update {	4490	sub update {
3875	my ($self) = @_;	4491	my ($self) = @_;
3876		4492
3877	$::WANT_REFRESH++;	4493	$::WANT_REFRESH = 1;
3878	}	4494	}
3879		4495
3880	sub add {	4496	sub add {
3881	my ($self, @children) = @_;	4497	my ($self, @children) = @_;
3882		4498
…		…
3919	while ($self->{refresh_hook}) {	4535	while ($self->{refresh_hook}) {
3920	$_->()	4536	$_->()
3921	for values %{delete $self->{refresh_hook}};	4537	for values %{delete $self->{refresh_hook}};
3922	}	4538	}
3923		4539
3924	if ($self->{realloc}) {	4540	while ($self->{realloc}) {
3925	my %queue;	4541	my %queue;
3926	my @queue;	4542	my @queue;
3927	my $widget;	4543	my $widget;
3928		4544
3929	outer:	4545	outer:
…		…
3949		4565
3950	delete $queue{$widget+0};	4566	delete $queue{$widget+0};
3951		4567
3952	my ($w, $h) = $widget->size_request;	4568	my ($w, $h) = $widget->size_request;
3953		4569
3954	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;	4570	$w += $widget->{padding_x} * 2;
3955	$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;
3956		4575
3957	$w = min $widget->{max_w}, $w if exists $widget->{max_w};	4576	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
3958	$h = min $widget->{max_h}, $h if exists $widget->{max_h};	4577	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3959		4578
3960	$w = $widget->{force_w} if exists $widget->{force_w};	4579	$w = $widget->{force_w} if exists $widget->{force_w};
…		…
3976	}	4595	}
3977	}	4596	}
3978		4597
3979	delete $self->{realloc}{$widget+0};	4598	delete $self->{realloc}{$widget+0};
3980	}	4599	}
3981	}
3982		4600
3983	while (my $size_alloc = delete $self->{size_alloc}) {	4601	while (my $size_alloc = delete $self->{size_alloc}) {
3984	my @queue = sort { $b->{visible} <=> $a->{visible} }	4602	my @queue = sort { $a->{visible} <=> $b->{visible} }
3985	values %$size_alloc;	4603	values %$size_alloc;
3986		4604
3987	while () {	4605	while () {
3988	my $widget = pop @queue || last;	4606	my $widget = pop @queue || last;
3989		4607
3990	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	4608	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3991		4609
3992	$w = 0 if $w < 0;	4610	$w = max $widget->{min_w}, $w;
3993	$h = 0 if $h < 0;	4611	$h = max $widget->{min_h}, $h;
3994		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
3995	$w = int $w + 0.5;	4619	$w = int $w + 0.5;
3996	$h = int $h + 0.5;	4620	$h = int $h + 0.5;
3997		4621
3998	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}) {
3999	$widget->{old_w} = $widget->{w};	4623	$widget->{old_w} = $widget->{w};
4000	$widget->{old_h} = $widget->{h};	4624	$widget->{old_h} = $widget->{h};
4001		4625
4002	$widget->{w} = $w;	4626	$widget->{w} = $w;
4003	$widget->{h} = $h;	4627	$widget->{h} = $h;
4004		4628
4005	$widget->emit (size_allocate => $w, $h);	4629	$widget->emit (size_allocate => $w, $h);
		4630	}
4006	}	4631	}
4007	}	4632	}
4008	}	4633	}
4009		4634
4010	while ($self->{post_alloc_hook}) {	4635	while ($self->{post_alloc_hook}) {
4011	$_->()	4636	$_->()
4012	for values %{delete $self->{post_alloc_hook}};	4637	for values %{delete $self->{post_alloc_hook}};
4013	}	4638	}
4014
4015		4639
4016	glViewport 0, 0, $::WIDTH, $::HEIGHT;	4640	glViewport 0, 0, $::WIDTH, $::HEIGHT;
4017	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	4641	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
4018	glClear GL_COLOR_BUFFER_BIT;	4642	glClear GL_COLOR_BUFFER_BIT;
4019		4643
…		…
4022	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4646	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
4023	glMatrixMode GL_MODELVIEW;	4647	glMatrixMode GL_MODELVIEW;
4024	glLoadIdentity;	4648	glLoadIdentity;
4025		4649
4026	{	4650	{
4027	package CFClient::UI::Base;	4651	package DC::UI::Base;
4028		4652
4029	($draw_x, $draw_y, $draw_w, $draw_h) =	4653	local ($draw_x, $draw_y, $draw_w, $draw_h) =
4030	(0, 0, $self->{w}, $self->{h});	4654	(0, 0, $self->{w}, $self->{h});
4031	}
4032		4655
4033	$self->_draw;	4656	$self->_draw;
		4657	}
4034	}	4658	}
4035		4659
4036	#############################################################################	4660	#############################################################################
4037		4661
4038	package CFClient::UI;	4662	package DC::UI;
4039		4663
4040	$ROOT = new CFClient::UI::Root;	4664	$ROOT = new DC::UI::Root;
4041	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4665	$TOOLTIP = new DC::UI::Tooltip z => 900;
4042		4666
4043	1	4667	1
4044

Diff Legend

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