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

Diff Legend

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