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.310 by root, Fri Jun 23 20:28:20 2006 UTC vs.
Revision 1.458 by root, Fri Dec 28 15:05:33 2007 UTC

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

Diff Legend

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