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

Diff Legend

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