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.302 by root, Mon Jun 12 13:26:14 2006 UTC vs.
Revision 1.462 by root, Thu Mar 20 22:28:33 2008 UTC

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

Diff Legend

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