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

Diff Legend

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