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.278 by root, Sun Jun 4 23:05:06 2006 UTC vs.
Revision 1.488 by root, Fri Nov 23 12:39:05 2012 UTC

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

Diff Legend

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