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.312 by root, Fri Jun 23 23:54:30 2006 UTC vs.
Revision 1.475 by root, Sun Jan 11 22:15:23 2009 UTC

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

Diff Legend

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