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.464 by root, Fri Jul 18 22:32:54 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
…		…
2323	sub set_value {	3070	sub set_value {
2324	my ($self, $value) = @_;	3071	my ($self, $value) = @_;
2325		3072
2326	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};	3073	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2327		3074
2328	$hi = $lo + 1 if $hi <= $lo;	3075	$hi = $lo if $hi < $lo;
2329		3076
2330	$page = $hi - $lo if $page > $hi - $lo;	3077	$value = $hi - $page if $value > $hi - $page;
2331
2332	$value = $lo if $value < $lo;	3078	$value = $lo if $value < $lo;
2333	$value = $hi - $page if $value > $hi - $page;
2334		3079
2335	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit	3080	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2336	if $unit;	3081	if $unit;
2337		3082
2338	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	3083	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2339		3084
2340	if ($value != $old_value) {	3085	if ($value != $old_value) {
2341	$self->_emit (changed => $value);	3086	$self->emit (changed => $value);
2342	$self->update;	3087	$self->update;
2343	}	3088	}
2344	}	3089	}
2345		3090
2346	sub size_request {	3091	sub size_request {
2347	my ($self) = @_;	3092	my ($self) = @_;
2348		3093
2349	($self->{req_w}, $self->{req_h})	3094	($self->{req_w}, $self->{req_h})
2350	}	3095	}
2351		3096
2352	sub button_down {	3097	sub invoke_button_down {
2353	my ($self, $ev, $x, $y) = @_;	3098	my ($self, $ev, $x, $y) = @_;
2354		3099
2355	$self->SUPER::button_down ($ev, $x, $y);	3100	$self->SUPER::invoke_button_down ($ev, $x, $y);
2356		3101
2357	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	3102	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2358		3103
2359	$self->mouse_motion ($ev, $x, $y)	3104	$self->invoke_mouse_motion ($ev, $x, $y);
2360	}
2361		3105
		3106	1
		3107	}
		3108
2362	sub mouse_motion {	3109	sub invoke_mouse_motion {
2363	my ($self, $ev, $x, $y) = @_;	3110	my ($self, $ev, $x, $y) = @_;
2364		3111
2365	if ($GRAB == $self) {	3112	if ($GRAB == $self) {
2366	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	3113	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2367		3114
…		…
2375	}	3122	}
2376		3123
2377	1	3124	1
2378	}	3125	}
2379		3126
		3127	sub invoke_mouse_wheel {
		3128	my ($self, $ev) = @_;
		3129
		3130	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		3131
		3132	my $pagepart = $ev->{mod} & DC::KMOD_SHIFT ? 1 : 0.2;
		3133
		3134	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
		3135
		3136	1
		3137	}
		3138
2380	sub update {	3139	sub update {
2381	my ($self) = @_;	3140	my ($self) = @_;
2382		3141
2383	delete $self->{knob_w};	3142	delete $self->{knob_w};
2384	$self->SUPER::update;	3143	$self->SUPER::update;
…		…
2388	my ($self) = @_;	3147	my ($self) = @_;
2389		3148
2390	unless ($self->{knob_w}) {	3149	unless ($self->{knob_w}) {
2391	$self->set_value ($self->{range}[0]);	3150	$self->set_value ($self->{range}[0]);
2392		3151
2393	my ($value, $lo, $hi, $page) = @{$self->{range}};	3152	my ($value, $lo, $hi, $page, $unit) = @{$self->{range}};
2394	my $range = ($hi - $page - $lo) || 1e-100;	3153	my $range = ($hi - $page - $lo) || 1e-10;
2395		3154
2396	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;	3155	my $knob_w = List::Util::min 1, $page / (($hi - $lo) || 1e-10) || 24 / $self->{w};
2397		3156
2398	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;	3157	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2399	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;	3158	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2400		3159
2401	$value = ($value - $lo) / $range;	3160	$value = ($value - $lo) / $range;
…		…
2431	glDisable GL_TEXTURE_2D;	3190	glDisable GL_TEXTURE_2D;
2432	}	3191	}
2433		3192
2434	#############################################################################	3193	#############################################################################
2435		3194
2436	package CFClient::UI::ValSlider;	3195	package DC::UI::ValSlider;
2437		3196
2438	our @ISA = CFClient::UI::HBox::;	3197	our @ISA = DC::UI::HBox::;
2439		3198
2440	sub new {	3199	sub new {
2441	my ($class, %arg) = @_;	3200	my ($class, %arg) = @_;
2442		3201
2443	my $range = delete $arg{range};	3202	my $range = delete $arg{range};
2444		3203
2445	my $self = $class->SUPER::new (	3204	my $self = $class->SUPER::new (
2446	slider => (new CFClient::UI::Slider expand => 1, range => $range),	3205	slider => (new DC::UI::Slider expand => 1, range => $range),
2447	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	3206	entry => (new DC::UI::Label text => "", template => delete $arg{template}),
2448	to_value => sub { shift },	3207	to_value => sub { shift },
2449	from_value => sub { shift },	3208	from_value => sub { shift },
2450	%arg,	3209	%arg,
2451	);	3210	);
2452		3211
…		…
2472	sub set_range { shift->{slider}->set_range (@_) }	3231	sub set_range { shift->{slider}->set_range (@_) }
2473	sub set_value { shift->{slider}->set_value (@_) }	3232	sub set_value { shift->{slider}->set_value (@_) }
2474		3233
2475	#############################################################################	3234	#############################################################################
2476		3235
2477	package CFClient::UI::TextScroller;	3236	package DC::UI::TextScroller;
2478		3237
2479	our @ISA = CFClient::UI::HBox::;	3238	our @ISA = DC::UI::HBox::;
2480		3239
2481	use CFClient::OpenGL;	3240	use DC::OpenGL;
2482		3241
2483	sub new {	3242	sub new {
2484	my $class = shift;	3243	my $class = shift;
2485		3244
2486	my $self = $class->SUPER::new (	3245	my $self = $class->SUPER::new (
2487	fontsize => 1,	3246	fontsize => 1,
2488	can_events => 0,	3247	can_events => 1,
2489	indent => 0,	3248	indent => 0,
2490	#font => default_font	3249	#font => default_font
2491	@_,	3250	@_,
2492		3251
2493	layout => (new CFClient::Layout 1),	3252	layout => (new DC::Layout),
2494	par => [],	3253	par => [],
		3254	max_par => 0,
2495	height => 0,	3255	height => 0,
2496	children => [	3256	children => [
2497	(new CFClient::UI::Empty expand => 1),	3257	(new DC::UI::Empty expand => 1),
2498	(new CFClient::UI::Slider vertical => 1),	3258	(new DC::UI::Slider vertical => 1),
2499	],	3259	],
2500	);	3260	);
2501		3261
2502	$self->{children}[1]->connect (changed => sub { $self->update });	3262	$self->{children}[1]->connect (changed => sub { $self->update });
2503		3263
…		…
2509		3269
2510	$self->{fontsize} = $fontsize;	3270	$self->{fontsize} = $fontsize;
2511	$self->reflow;	3271	$self->reflow;
2512	}	3272	}
2513		3273
		3274	sub size_request {
		3275	my ($self) = @_;
		3276
		3277	my ($empty, $slider) = $self->visible_children;
		3278
		3279	local $self->{children} = [$empty, $slider];
		3280	$self->SUPER::size_request
		3281	}
		3282
2514	sub size_allocate {	3283	sub invoke_size_allocate {
2515	my ($self, $w, $h) = @_;	3284	my ($self, $w, $h) = @_;
2516		3285
2517	$self->SUPER::size_allocate ($w, $h);	3286	my ($empty, $slider, @other) = @{ $self->{children} };
		3287	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2518		3288
2519	$self->{layout}->set_font ($self->{font}) if $self->{font};	3289	$self->{layout}->set_font ($self->{font}) if $self->{font};
2520	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	3290	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2521	$self->{layout}->set_width ($self->{children}[0]{w});	3291	$self->{layout}->set_width ($empty->{w});
2522	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	3292	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2523		3293
2524	$self->reflow;	3294	$self->reflow;
2525	}
2526		3295
2527	sub text_size {	3296	local $self->{children} = [$empty, $slider];
		3297	$self->SUPER::invoke_size_allocate ($w, $h)
		3298	}
		3299
		3300	sub invoke_mouse_wheel {
2528	my ($self, $text, $indent) = @_;	3301	my ($self, $ev) = @_;
		3302
		3303	return 0 unless $ev->{dy}; # only vertical movements
		3304
		3305	$self->{children}[1]->emit (mouse_wheel => $ev);
		3306
		3307	1
		3308	}
		3309
		3310	sub get_layout {
		3311	my ($self, $para) = @_;
2529		3312
2530	my $layout = $self->{layout};	3313	my $layout = $self->{layout};
2531		3314
		3315	$layout->set_font ($self->{font}) if $self->{font};
		3316	$layout->set_foreground (@{$para->{fg}});
2532	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	3317	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2533	$layout->set_width ($self->{children}[0]{w} - $indent);	3318	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2534	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	3319	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2535	$layout->set_markup ($text);	3320	$layout->set_markup ($para->{markup});
		3321
		3322	$layout->set_shapes (
		3323	map
		3324	+(0, $_->baseline_shift + $_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		3325	@{$para->{widget}}
2536		3326	);
		3327
2537	$layout->size	3328	$layout
2538	}	3329	}
2539		3330
2540	sub reflow {	3331	sub reflow {
2541	my ($self) = @_;	3332	my ($self) = @_;
2542		3333
…		…
2549		3340
2550	# todo: base offset on lines or so, not on pixels	3341	# todo: base offset on lines or so, not on pixels
2551	$self->{children}[1]->set_value ($offset);	3342	$self->{children}[1]->set_value ($offset);
2552	}	3343	}
2553		3344
		3345	sub current_paragraph {
		3346	my ($self) = @_;
		3347
		3348	$self->{top_paragraph} - 1
		3349	}
		3350
		3351	sub scroll_to {
		3352	my ($self, $para) = @_;
		3353
		3354	$para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
		3355
		3356	$self->{scroll_to} = $para;
		3357	$self->update;
		3358	}
		3359
2554	sub clear {	3360	sub clear {
2555	my ($self) = @_;	3361	my ($self) = @_;
		3362
		3363	my (undef, undef, @other) = @{ $self->{children} };
		3364	$self->remove ($_) for @other;
2556		3365
2557	$self->{par} = [];	3366	$self->{par} = [];
2558	$self->{height} = 0;	3367	$self->{height} = 0;
2559	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	3368	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2560	}	3369	}
2561		3370
2562	sub add_paragraph {	3371	sub add_paragraph {
2563	my ($self, $color, $text, $indent) = @_;	3372	my $self = shift;
2564		3373
2565	for my $line (split /\n/, $text) {	3374	for my $para (@_) {
2566	my ($w, $h) = $self->text_size ($line);	3375	$para = {
		3376	fg => [1, 1, 1, 1],
		3377	indent => 0,
		3378	markup => "",
		3379	widget => [],
		3380	ref $para ? %$para : (markup => $para),
		3381	w => 1e10,
		3382	wrapped => 1,
		3383	};
		3384
		3385	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		3386	push @{$self->{par}}, $para;
		3387	}
		3388
		3389	if (my $max = $self->{max_par}) {
		3390	shift @{$self->{par}} while @{$self->{par}} > $max;
		3391	}
		3392
		3393	$self->{need_reflow}++;
		3394	$self->update;
		3395	}
		3396
		3397	sub scroll_to_bottom {
		3398	my ($self) = @_;
		3399
		3400	$self->{scroll_to} = $#{$self->{par}};
		3401	$self->update;
		3402	}
		3403
		3404	sub force_uptodate {
		3405	my ($self) = @_;
		3406
		3407	if (delete $self->{need_reflow}) {
		3408	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		3409
		3410	my $height = 0;
		3411
		3412	for my $para (@{$self->{par}}) {
		3413	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		3414	my $layout = $self->get_layout ($para);
		3415	my ($w, $h) = $layout->size;
		3416
		3417	$para->{w} = $w + $para->{indent};
		3418	$para->{h} = $h;
		3419	$para->{wrapped} = $layout->has_wrapped;
		3420	}
		3421
		3422	$para->{y} = $height;
		3423	$height += $para->{h};
		3424	}
		3425
2567	$self->{height} += $h;	3426	$self->{height} = $height;
2568	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	3427	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2569	}
2570		3428
2571	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	3429	delete $self->{texture};
		3430	}
		3431
		3432	if (my $paridx = delete $self->{scroll_to}) {
		3433	$self->{children}[1]->set_value ($self->{par}[$paridx]{y});
		3434	}
2572	}	3435	}
2573		3436
2574	sub update {	3437	sub update {
2575	my ($self) = @_;	3438	my ($self) = @_;
2576		3439
…		…
2579	return unless $self->{h} > 0;	3442	return unless $self->{h} > 0;
2580		3443
2581	delete $self->{texture};	3444	delete $self->{texture};
2582		3445
2583	$ROOT->on_post_alloc ($self => sub {	3446	$ROOT->on_post_alloc ($self => sub {
		3447	$self->force_uptodate;
		3448
2584	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3449	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2585		3450
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 {	3451	$self->{texture} ||= new_from_opengl DC::Texture $W, $H, sub {
2614	glClearColor 0, 0, 0, 0;	3452	glClearColor 0, 0, 0, 0;
2615	glClear GL_COLOR_BUFFER_BIT;	3453	glClear GL_COLOR_BUFFER_BIT;
2616		3454
		3455	package DC::UI::Base;
		3456	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		3457	(0, 0, $self->{w}, $self->{h});
		3458
		3459	my $top = int $self->{children}[1]{range}[0];
		3460
		3461	my $paridx = 0;
		3462	my $top_paragraph;
2617	my $top = int $self->{children}[1]{range}[0];	3463	my $top = int $self->{children}[1]{range}[0];
2618		3464
2619	my $y0 = $top;	3465	my $y0 = $top;
2620	my $y1 = $top + $H;	3466	my $y1 = $top + $H;
2621		3467
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}}) {	3468	for my $para (@{$self->{par}}) {
2633	my $h = $par->[1];	3469	my $h = $para->{h};
		3470	my $y = $para->{y};
2634		3471
2635	if ($y0 < $y + $h && $y < $y1) {	3472	if ($y0 < $y + $h && $y < $y1) {
2636	$layout->set_foreground (@{ $par->[2] });	3473	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		3474
2641	my ($w, $h, $data, $format, $internalformat) = $layout->render;	3475	$layout->render ($para->{indent}, $y - $y0);
		3476	$layout->draw;
2642		3477
2643	glRasterPos $par->[3], $y - $y0;	3478	if (my @w = @{ $para->{widget} }) {
2644	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	3479	my @s = $layout->get_shapes;
		3480
		3481	for (@w) {
		3482	my ($dx, $dy) = splice @s, 0, 2, ();
		3483
		3484	$_->{x} = $dx + $para->{indent};
		3485	$_->{y} = $dy + $y - $y0;
		3486
		3487	$_->draw;
		3488	}
		3489	}
2645	}	3490	}
2646		3491
2647	$y += $h;	3492	$paridx++;
		3493	$top_paragraph ||= $paridx if $y >= $top;
2648	}	3494	}
2649		3495
2650	glDisable GL_BLEND;	3496	$self->{top_paragraph} = $top_paragraph;
2651	};	3497	};
2652	});	3498	});
		3499	}
		3500
		3501	sub reconfigure {
		3502	my ($self) = @_;
		3503
		3504	$self->SUPER::reconfigure;
		3505
		3506	$_->{w} = 1e10 for @{ $self->{par} };
		3507	$self->reflow;
2653	}	3508	}
2654		3509
2655	sub _draw {	3510	sub _draw {
2656	my ($self) = @_;	3511	my ($self) = @_;
2657		3512
…		…
2660	glColor 0, 0, 0, 1;	3515	glColor 0, 0, 0, 1;
2661	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	3516	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2662	glDisable GL_TEXTURE_2D;	3517	glDisable GL_TEXTURE_2D;
2663		3518
2664	$self->{children}[1]->draw;	3519	$self->{children}[1]->draw;
2665
2666	}	3520	}
2667		3521
2668	#############################################################################	3522	#############################################################################
2669		3523
2670	package CFClient::UI::Animator;	3524	package DC::UI::Animator;
2671		3525
2672	use CFClient::OpenGL;	3526	use DC::OpenGL;
2673		3527
2674	our @ISA = CFClient::UI::Bin::;	3528	our @ISA = DC::UI::Bin::;
2675		3529
2676	sub moveto {	3530	sub moveto {
2677	my ($self, $x, $y) = @_;	3531	my ($self, $x, $y) = @_;
2678		3532
2679	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3533	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2707	glPopMatrix;	3561	glPopMatrix;
2708	}	3562	}
2709		3563
2710	#############################################################################	3564	#############################################################################
2711		3565
2712	package CFClient::UI::Flopper;	3566	package DC::UI::Flopper;
2713		3567
2714	our @ISA = CFClient::UI::Button::;	3568	our @ISA = DC::UI::Button::;
2715		3569
2716	sub new {	3570	sub new {
2717	my $class = shift;	3571	my $class = shift;
2718		3572
2719	my $self = $class->SUPER::new (	3573	my $self = $class->SUPER::new (
…		…
2731	$self->{other}->toggle_visibility;	3585	$self->{other}->toggle_visibility;
2732	}	3586	}
2733		3587
2734	#############################################################################	3588	#############################################################################
2735		3589
2736	package CFClient::UI::Tooltip;	3590	package DC::UI::Tooltip;
2737		3591
2738	our @ISA = CFClient::UI::Bin::;	3592	our @ISA = DC::UI::Bin::;
2739		3593
2740	use CFClient::OpenGL;	3594	use DC::OpenGL;
2741		3595
2742	sub new {	3596	sub new {
2743	my $class = shift;	3597	my $class = shift;
2744		3598
2745	$class->SUPER::new (	3599	$class->SUPER::new (
…		…
2749	}	3603	}
2750		3604
2751	sub set_tooltip_from {	3605	sub set_tooltip_from {
2752	my ($self, $widget) = @_;	3606	my ($self, $widget) = @_;
2753		3607
2754	my $tooltip = $widget->{tooltip};	3608	my $tip = $widget->{tooltip};
		3609	$tip = $tip->($widget) if "CODE" eq ref $tip;
		3610
		3611	$tip = DC::Pod::section_label tooltip => $1
		3612	if $tip =~ /^#(.*)$/;
2755		3613
2756	if ($ENV{CFPLUS_DEBUG} & 2) {	3614	if ($ENV{CFPLUS_DEBUG} & 2) {
2757	$tooltip .= "\n\n" . (ref $widget) . "\n"	3615	$tip .= "\n\n" . (ref $widget) . "\n"
2758	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	3616	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2759	. "req $widget->{req_w} $widget->{req_h}\n"	3617	. "req $widget->{req_w} $widget->{req_h}\n"
2760	. "visible $widget->{visible}";	3618	. "visible $widget->{visible}";
2761	}	3619	}
2762		3620
2763	$tooltip =~ s/^\n+//;	3621	$tip =~ s/^\n+//;
2764	$tooltip =~ s/\n+$//;	3622	$tip =~ s/\n+$//;
2765		3623
2766	$self->add (new CFClient::UI::Label	3624	$self->add (new DC::UI::Label
2767	markup => $tooltip,	3625	markup => $tip,
2768	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3626	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
		3627	align => 0,
2769	fontsize => 0.8,	3628	fontsize => 0.8,
2770	fg => [0, 0, 0, 1],	3629	style => 1, # FLAG_INVERSE
2771	ellipsise => 0,	3630	ellipsise => 0,
2772	font => ($widget->{tooltip_font} || $::FONT_PROP),	3631	font => ($widget->{tooltip_font} || $::FONT_PROP),
2773	);	3632	);
2774	}	3633	}
2775		3634
…		…
2779	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	3638	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2780		3639
2781	($w + 4, $h + 4)	3640	($w + 4, $h + 4)
2782	}	3641	}
2783		3642
2784	sub size_allocate {	3643	sub invoke_size_allocate {
2785	my ($self, $w, $h) = @_;	3644	my ($self, $w, $h) = @_;
2786		3645
2787	$self->SUPER::size_allocate ($w - 4, $h - 4);	3646	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2788	}	3647	}
2789		3648
2790	sub visibility_change {	3649	sub invoke_visibility_change {
2791	my ($self, $visible) = @_;	3650	my ($self, $visible) = @_;
2792		3651
2793	return unless $visible;	3652	return unless $visible;
2794		3653
2795	$self->{root}->on_post_alloc ("move_$self" => sub {	3654	$self->{root}->on_post_alloc ("move_$self" => sub {
2796	my $widget = $self->{owner}	3655	my $widget = $self->{owner}
2797	or return;	3656	or return;
2798		3657
		3658	if ($widget->{visible}) {
2799	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3659	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2800		3660
2801	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3661	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2802	if $x + $self->{w} > $self->{root}{w};	3662	if $x + $self->{w} > $self->{root}{w};
2803		3663
2804	$self->move_abs ($x, $y);	3664	$self->move_abs ($x, $y);
		3665	} else {
		3666	$self->hide;
		3667	}
2805	});	3668	});
2806	}	3669	}
2807		3670
2808	sub _draw {	3671	sub _draw {
2809	my ($self) = @_;	3672	my ($self) = @_;
2810		3673
2811	glTranslate 0.375, 0.375;
2812
2813	my ($w, $h) = @$self{qw(w h)};	3674	my ($w, $h) = @$self{qw(w h)};
2814		3675
2815	glColor 1, 0.8, 0.4;	3676	glColor 1, 0.8, 0.4;
2816	glBegin GL_QUADS;	3677	glRect 0, 0, $w, $h;
2817	glVertex 0 , 0;
2818	glVertex 0 , $h;
2819	glVertex $w, $h;
2820	glVertex $w, 0;
2821	glEnd;
2822		3678
2823	glColor 0, 0, 0;	3679	glColor 0, 0, 0;
2824	glBegin GL_LINE_LOOP;	3680	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		3681
2831	glTranslate 2 - 0.375, 2 - 0.375;	3682	glTranslate 2, 2;
2832		3683
2833	$self->SUPER::_draw;	3684	$self->SUPER::_draw;
2834	}	3685	}
2835		3686
2836	#############################################################################	3687	#############################################################################
2837		3688
2838	package CFClient::UI::Face;	3689	package DC::UI::Face;
2839		3690
2840	our @ISA = CFClient::UI::Base::;	3691	our @ISA = DC::UI::DrawBG::;
2841		3692
2842	use CFClient::OpenGL;	3693	use DC::OpenGL;
2843		3694
2844	sub new {	3695	sub new {
2845	my $class = shift;	3696	my $class = shift;
2846		3697
2847	my $self = $class->SUPER::new (	3698	my $self = $class->SUPER::new (
		3699	size_w => 32,
		3700	size_h => 8,
2848	aspect => 1,	3701	aspect => 1,
2849	can_events => 0,	3702	can_events => 0,
2850	@_,	3703	@_,
2851	);	3704	);
2852		3705
2853	if ($self->{anim} && $self->{animspeed}) {	3706	if ($self->{anim} && $self->{animspeed}) {
2854	Scalar::Util::weaken (my $widget = $self);	3707	DC::weaken (my $widget = $self);
2855		3708
2856	$self->{timer} = Event->timer (	3709	$self->{animspeed} = List::Util::max 0.05, $self->{animspeed};
2857	at => $self->{animspeed} * int $::NOW / $self->{animspeed},	3710	$self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub {
2858	hard => 1,	3711	return unless $::CONN;
2859	interval => $self->{animspeed},	3712
2860	cb => sub {	3713	my $w = $widget
		3714	or return;
		3715
2861	++$widget->{frame};	3716	++$w->{frame};
		3717	$w->update_face;
		3718
		3719	# somehow, $widget can go away
2862	$widget->update;	3720	$w->update;
2863	},	3721	$w->update_timer;
2864	);	3722	};
		3723
		3724	$self->update_face;
		3725	$self->update_timer;
2865	}	3726	}
2866		3727
2867	$self	3728	$self
2868	}	3729	}
2869		3730
		3731	sub update_timer {
		3732	my ($self) = @_;
		3733
		3734	return unless $self->{timer};
		3735
		3736	if ($self->{visible}) {
		3737	$self->{timer}->start;
		3738	} else {
		3739	$self->{timer}->stop;
		3740	}
		3741	}
		3742
		3743	sub update_face {
		3744	my ($self) = @_;
		3745
		3746	if ($::CONN) {
		3747	if (my $anim = $::CONN->{anim}[$self->{anim}]) {
		3748	if ($anim && @$anim) {
		3749	$self->{face} = $anim->[ $self->{frame} % @$anim ];
		3750	delete $self->{face_change_cb};
		3751
		3752	if (my $tex = $self->{tex} = $::CONN->{texture}[ $::CONN->{face}[$self->{face}]{id} ]) {
		3753	unless ($tex->{name} || $tex->{loading}) {
		3754	$tex->upload (sub { $self->reconfigure });
		3755	}
		3756	}
		3757	}
		3758	}
		3759	}
		3760	}
		3761
2870	sub size_request {	3762	sub size_request {
2871	(32, 8)	3763	my ($self) = @_;
		3764
		3765	if ($::CONN) {
		3766	if (my $faceid = $::CONN->{face}[$self->{face}]{id}) {
		3767	if (my $tex = $self->{tex} = $::CONN->{texture}[$faceid]) {
		3768	if ($tex->{name}) {
		3769	return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
		3770	} elsif (!$tex->{loading}) {
		3771	$tex->upload (sub { $self->reconfigure });
		3772	}
		3773	}
		3774
		3775	$self->{face_change_cb} ||= $::CONN->on_face_change ($self->{face}, sub { $self->reconfigure });
		3776	}
		3777	}
		3778
		3779	($self->{size_w} || 8, $self->{size_h} || 8)
2872	}	3780	}
2873		3781
2874	sub update {	3782	sub update {
2875	my ($self) = @_;	3783	my ($self) = @_;
2876		3784
2877	return unless $self->{visible};	3785	return unless $self->{visible};
2878		3786
2879	$self->SUPER::update;	3787	$self->SUPER::update;
2880	}	3788	}
2881		3789
		3790	sub invoke_visibility_change {
		3791	my ($self) = @_;
		3792
		3793	$self->update_timer;
		3794
		3795	0
		3796	}
		3797
2882	sub _draw {	3798	sub _draw {
2883	my ($self) = @_;	3799	my ($self) = @_;
2884		3800
2885	return unless $::CONN;	3801	$self->SUPER::_draw;
2886		3802
2887	my $face;	3803	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;	3804	glEnable GL_TEXTURE_2D;
2900	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3805	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2901	glColor 0, 0, 0, 1;	3806	glColor 0, 0, 0, 1;
2902	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3807	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2903	glDisable GL_TEXTURE_2D;	3808	glDisable GL_TEXTURE_2D;
…		…
2905	}	3810	}
2906		3811
2907	sub destroy {	3812	sub destroy {
2908	my ($self) = @_;	3813	my ($self) = @_;
2909		3814
2910	$self->{timer}->cancel	3815	(delete $self->{timer})->cancel
2911	if $self->{timer};	3816	if $self->{timer};
2912		3817
2913	$self->SUPER::destroy;	3818	$self->SUPER::destroy;
2914	}	3819	}
2915		3820
2916	#############################################################################	3821	#############################################################################
2917		3822
2918	package CFClient::UI::Buttonbar;	3823	package DC::UI::Buttonbar;
2919		3824
2920	our @ISA = CFClient::UI::HBox::;	3825	our @ISA = DC::UI::HBox::;
2921		3826
2922	# TODO: should actualyl wrap buttons and other goodies.	3827	# TODO: should actually wrap buttons and other goodies.
2923		3828
2924	#############################################################################	3829	#############################################################################
2925		3830
2926	package CFClient::UI::Menu;	3831	package DC::UI::Menu;
2927		3832
2928	our @ISA = CFClient::UI::FancyFrame::;	3833	our @ISA = DC::UI::Toplevel::;
2929		3834
2930	use CFClient::OpenGL;	3835	use DC::OpenGL;
2931		3836
2932	sub new {	3837	sub new {
2933	my $class = shift;	3838	my $class = shift;
2934		3839
2935	my $self = $class->SUPER::new (	3840	my $self = $class->SUPER::new (
2936	items => [],	3841	items => [],
2937	z => 100,	3842	z => 100,
2938	@_,	3843	@_,
2939	);	3844	);
2940		3845
2941	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3846	$self->add ($self->{vbox} = new DC::UI::VBox);
2942		3847
2943	for my $item (@{ $self->{items} }) {	3848	for my $item (@{ $self->{items} }) {
2944	my ($widget, $cb, $tooltip) = @$item;	3849	my ($widget, $cb, $tooltip) = @$item;
2945		3850
2946	# handle various types of items, only text for now	3851	# handle various types of items, only text for now
2947	if (!ref $widget) {	3852	if (!ref $widget) {
		3853	if ($widget =~ /\t/) {
		3854	my ($left, $right) = split /\t/, $widget, 2;
		3855
2948	$widget = new CFClient::UI::Label	3856	$widget = new DC::UI::HBox
2949	can_hover => 1,	3857	can_hover => 1,
2950	can_events => 1,	3858	can_events => 1,
		3859	tooltip => $tooltip,
		3860	children => [
		3861	(new DC::UI::Label markup => $left , align => 0, expand => 1),
		3862	(new DC::UI::Label markup => $right, align => 1),
		3863	],
		3864	;
		3865
		3866	} else {
		3867	$widget = new DC::UI::Label
		3868	can_hover => 1,
		3869	can_events => 1,
		3870	align => 0,
2951	markup => $widget,	3871	markup => $widget,
2952	tooltip => $tooltip	3872	tooltip => $tooltip;
		3873	}
2953	}	3874	}
2954		3875
2955	$self->{item}{$widget} = $item;	3876	$self->{item}{$widget} = $item;
2956		3877
2957	$self->{vbox}->add ($widget);	3878	$self->{vbox}->add ($widget);
…		…
2962		3883
2963	# popup given the event (must be a mouse button down event currently)	3884	# popup given the event (must be a mouse button down event currently)
2964	sub popup {	3885	sub popup {
2965	my ($self, $ev) = @_;	3886	my ($self, $ev) = @_;
2966		3887
2967	$self->_emit ("popdown");	3888	$self->emit ("popdown");
2968		3889
2969	# maybe save $GRAB? must be careful about events...	3890	# maybe save $GRAB? must be careful about events...
2970	$GRAB = $self;	3891	$GRAB = $self;
2971	$self->{button} = $ev->{button};	3892	$self->{button} = $ev->{button};
2972		3893
2973	$self->show;	3894	$self->show;
2974	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3895	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2975	}	3896	}
2976		3897
2977	sub mouse_motion {	3898	sub invoke_mouse_motion {
2978	my ($self, $ev, $x, $y) = @_;	3899	my ($self, $ev, $x, $y) = @_;
2979		3900
2980	# TODO: should use vbox->find_widget or so	3901	# TODO: should use vbox->find_widget or so
2981	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3902	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2982	$self->{hover} = $self->{item}{$HOVER};	3903	$self->{hover} = $self->{item}{$HOVER};
2983		3904
2984	0	3905	0
2985	}	3906	}
2986		3907
2987	sub button_up {	3908	sub invoke_button_up {
2988	my ($self, $ev, $x, $y) = @_;	3909	my ($self, $ev, $x, $y) = @_;
2989		3910
2990	if ($ev->{button} == $self->{button}) {	3911	if ($ev->{button} == $self->{button}) {
2991	undef $GRAB;	3912	undef $GRAB;
2992	$self->hide;	3913	$self->hide;
2993		3914
2994	$self->_emit ("popdown");	3915	$self->emit ("popdown");
2995	$self->{hover}[1]->() if $self->{hover};	3916	$self->{hover}[1]->() if $self->{hover};
2996	} else {	3917	} else {
2997	return 0	3918	return 0
2998	}	3919	}
2999		3920
3000	1	3921	1
3001	}	3922	}
3002		3923
3003	#############################################################################	3924	#############################################################################
3004		3925
3005	package CFClient::UI::Multiplexer;	3926	package DC::UI::Multiplexer;
3006		3927
3007	our @ISA = CFClient::UI::Container::;	3928	our @ISA = DC::UI::Container::;
3008		3929
3009	sub new {	3930	sub new {
3010	my $class = shift;	3931	my $class = shift;
3011		3932
3012	my $self = $class->SUPER::new (	3933	my $self = $class->SUPER::new (
…		…
3026		3947
3027	$self->{current} = $self->{children}[0]	3948	$self->{current} = $self->{children}[0]
3028	if @{ $self->{children} };	3949	if @{ $self->{children} };
3029	}	3950	}
3030		3951
		3952	sub get_current_page {
		3953	my ($self) = @_;
		3954
		3955	$self->{current}
		3956	}
		3957
3031	sub set_current_page {	3958	sub set_current_page {
3032	my ($self, $page_or_widget) = @_;	3959	my ($self, $page_or_widget) = @_;
3033		3960
3034	my $widget = ref $page_or_widget	3961	my $widget = ref $page_or_widget
3035	? $page_or_widget	3962	? $page_or_widget
3036	: $self->{children}[$page_or_widget];	3963	: $self->{children}[$page_or_widget];
3037		3964
3038	$self->{current} = $widget;	3965	$self->{current} = $widget;
3039	$self->{current}->configure (0, 0, $self->{w}, $self->{h});	3966	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
3040		3967
3041	$self->_emit (page_changed => $self->{current});	3968	$self->emit (page_changed => $self->{current});
3042		3969
3043	$self->realloc;	3970	$self->realloc;
3044	}	3971	}
3045		3972
3046	sub visible_children {	3973	sub visible_children {
…		…
3051	my ($self) = @_;	3978	my ($self) = @_;
3052		3979
3053	$self->{current}->size_request	3980	$self->{current}->size_request
3054	}	3981	}
3055		3982
3056	sub size_allocate {	3983	sub invoke_size_allocate {
3057	my ($self, $w, $h) = @_;	3984	my ($self, $w, $h) = @_;
3058		3985
3059	$self->{current}->configure (0, 0, $w, $h);	3986	$self->{current}->configure (0, 0, $w, $h);
		3987
		3988	1
3060	}	3989	}
3061		3990
3062	sub _draw {	3991	sub _draw {
3063	my ($self) = @_;	3992	my ($self) = @_;
3064		3993
3065	$self->{current}->draw;	3994	$self->{current}->draw;
3066	}	3995	}
3067		3996
3068	#############################################################################	3997	#############################################################################
3069		3998
3070	package CFClient::UI::Notebook;	3999	package DC::UI::Notebook;
3071		4000
		4001	use DC::OpenGL;
		4002
3072	our @ISA = CFClient::UI::VBox::;	4003	our @ISA = DC::UI::VBox::;
3073		4004
3074	sub new {	4005	sub new {
3075	my $class = shift;	4006	my $class = shift;
3076		4007
3077	my $self = $class->SUPER::new (	4008	my $self = $class->SUPER::new (
3078	buttonbar => (new CFClient::UI::Buttonbar),	4009	buttonbar => (new DC::UI::Buttonbar),
3079	multiplexer => (new CFClient::UI::Multiplexer expand => 1),	4010	multiplexer => (new DC::UI::Multiplexer expand => 1),
		4011	active_outline => [.7, .7, 0.2],
3080	# filter => # will be put between multiplexer and $self	4012	# filter => # will be put between multiplexer and $self
3081	@_,	4013	@_,
3082	);	4014	);
3083		4015
3084	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};	4016	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3085	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});	4017	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
3086		4018
		4019	{
		4020	Scalar::Util::weaken (my $wself = $self);
		4021
		4022	$self->{multiplexer}->connect (c_add => sub {
		4023	my ($mplex, $widgets) = @_;
		4024
		4025	for my $child (@$widgets) {
		4026	Scalar::Util::weaken $child;
		4027	$child->{c_tab_} ||= do {
		4028	my $tab =
		4029	(UNIVERSAL::isa $child->{c_tab}, "DC::UI::Base")
		4030	? $child->{c_tab}
		4031	: new DC::UI::Button markup => $child->{c_tab}[0], tooltip => $child->{c_tab}[1];
		4032
		4033	$tab->connect (activate => sub {
		4034	$wself->set_current_page ($child);
		4035	});
		4036
		4037	$tab
		4038	};
		4039
		4040	$self->{buttonbar}->add ($child->{c_tab_});
		4041	}
		4042	});
		4043
		4044	$self->{multiplexer}->connect (c_remove => sub {
		4045	my ($mplex, $widgets) = @_;
		4046
		4047	for my $child (@$widgets) {
		4048	$wself->{buttonbar}->remove ($child->{c_tab_});
		4049	}
		4050	});
		4051	}
		4052
3087	$self	4053	$self
3088	}	4054	}
3089		4055
3090	sub add {	4056	sub add {
		4057	my ($self, @widgets) = @_;
		4058
		4059	$self->{multiplexer}->add (@widgets)
		4060	}
		4061
		4062	sub remove {
		4063	my ($self, @widgets) = @_;
		4064
		4065	$self->{multiplexer}->remove (@widgets)
		4066	}
		4067
		4068	sub pages {
		4069	my ($self) = @_;
		4070	$self->{multiplexer}->children
		4071	}
		4072
		4073	sub page_index {
		4074	my ($self, $widget) = @_;
		4075
		4076	my $i = 0;
		4077	for ($self->pages) {
		4078	if ($_ eq $widget) { return $i };
		4079	$i++;
		4080	}
		4081
		4082	undef
		4083	}
		4084
		4085	sub add_tab {
3091	my ($self, $title, $widget, $tooltip) = @_;	4086	my ($self, $title, $widget, $tooltip) = @_;
3092		4087
3093	Scalar::Util::weaken $self;	4088	$title = [$title, $tooltip] unless ref $title;
		4089	$widget->{c_tab} = $title;
3094		4090
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);	4091	$self->add ($widget);
		4092	}
		4093
		4094	sub get_current_page {
		4095	my ($self) = @_;
		4096
		4097	$self->{multiplexer}->get_current_page
3102	}	4098	}
3103		4099
3104	sub set_current_page {	4100	sub set_current_page {
3105	my ($self, $page) = @_;	4101	my ($self, $page) = @_;
3106		4102
3107	$self->{multiplexer}->set_current_page ($page);	4103	$self->{multiplexer}->set_current_page ($page);
3108	$self->_emit (page_changed => $self->{multiplexer}{current});	4104	$self->emit (page_changed => $self->{multiplexer}{current});
		4105	}
		4106
		4107	sub _draw {
		4108	my ($self) = @_;
		4109
		4110	$self->SUPER::_draw ();
		4111
		4112	if (my $cur = $self->{multiplexer}{current}) {
		4113	if ($cur = $cur->{c_tab_}) {
		4114	glTranslate $self->{buttonbar}{x} + $cur->{x},
		4115	$self->{buttonbar}{y} + $cur->{y};
		4116	glLineWidth 3;
		4117	#glEnable GL_BLEND;
		4118	#glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
		4119	glColor @{$self->{active_outline}};
		4120	glRect_lineloop 1.5, 1.5, $cur->{w} - 1.5, $cur->{h} - 1.5;
		4121	glLineWidth 1;
		4122	#glDisable GL_BLEND;
		4123	}
		4124	}
3109	}	4125	}
3110		4126
3111	#############################################################################	4127	#############################################################################
3112		4128
3113	package CFClient::UI::Combobox;	4129	package DC::UI::Selector;
3114		4130
3115	use utf8;	4131	use utf8;
3116		4132
3117	our @ISA = CFClient::UI::Button::;	4133	our @ISA = DC::UI::Button::;
3118		4134
3119	sub new {	4135	sub new {
3120	my $class = shift;	4136	my $class = shift;
3121		4137
3122	my $self = $class->SUPER::new (	4138	my $self = $class->SUPER::new (
…		…
3128	$self->_set_value ($self->{value});	4144	$self->_set_value ($self->{value});
3129		4145
3130	$self	4146	$self
3131	}	4147	}
3132		4148
3133	sub button_down {	4149	sub invoke_button_down {
3134	my ($self, $ev) = @_;	4150	my ($self, $ev) = @_;
3135		4151
3136	my @menu_items;	4152	my @menu_items;
3137		4153
3138	for (@{ $self->{options} }) {	4154	for (@{ $self->{options} }) {
3139	my ($value, $title, $tooltip) = @$_;	4155	my ($value, $title, $tooltip) = @$_;
3140		4156
3141	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];	4157	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3142	}	4158	}
3143		4159
3144	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);	4160	DC::UI::Menu->new (items => \@menu_items)->popup ($ev);
3145	}	4161	}
3146		4162
3147	sub _set_value {	4163	sub _set_value {
3148	my ($self, $value) = @_;	4164	my ($self, $value) = @_;
3149		4165
3150	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }	4166	my ($item) = grep $_->[0] eq $value, @{ $self->{options} };
		4167	$item ||= $self->{options}[0]
3151	or return;	4168	or return;
3152		4169
3153	$self->{value} = $item->[0];	4170	$self->{value} = $item->[0];
3154	$self->set_markup ("$item->[1] ⇓");	4171	$self->set_markup ("$item->[1] ⇓");
3155	$self->set_tooltip ($item->[2]);	4172	# $self->set_tooltip ($item->[2]);
3156	}	4173	}
3157		4174
3158	sub set_value {	4175	sub set_value {
3159	my ($self, $value) = @_;	4176	my ($self, $value) = @_;
3160		4177
3161	return unless $self->{value} ne $value;	4178	return unless $self->{value} ne $value;
3162		4179
3163	$self->_set_value ($value);	4180	$self->_set_value ($value);
3164	$self->_emit (changed => $value);	4181	$self->emit (changed => $value);
		4182	}
		4183
		4184	sub set_options {
		4185	my ($self, $options) = @_;
		4186
		4187	$self->{options} = $options;
		4188	$self->_set_value ($self->{value});
3165	}	4189	}
3166		4190
3167	#############################################################################	4191	#############################################################################
3168		4192
3169	package CFClient::UI::Statusbox;	4193	package DC::UI::Statusbox;
3170		4194
3171	our @ISA = CFClient::UI::VBox::;	4195	our @ISA = DC::UI::VBox::;
3172		4196
3173	sub new {	4197	sub new {
3174	my $class = shift;	4198	my $class = shift;
3175		4199
3176	my $self = $class->SUPER::new (	4200	my $self = $class->SUPER::new (
3177	fontsize => 0.8,	4201	fontsize => 0.8,
3178	@_,	4202	@_,
3179	);	4203	);
3180		4204
3181	Scalar::Util::weaken (my $this = $self);	4205	DC::weaken (my $this = $self);
3182		4206
3183	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });	4207	$self->{timer} = EV::timer 1, 1, sub { $this->reorder };
3184		4208
3185	$self	4209	$self
3186	}	4210	}
3187		4211
3188	sub reorder {	4212	sub reorder {
3189	my ($self) = @_;	4213	my ($self) = @_;
3190	my $NOW = Time::HiRes::time;	4214	my $NOW = Time::HiRes::time;
3191		4215
3192	# freeze display when hovering over any label	4216	# freeze display when hovering over any label
3193	return if $CFClient::UI::TOOLTIP->{owner}	4217	return if $DC::UI::TOOLTIP->{owner}
3194	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},	4218	&& grep $DC::UI::TOOLTIP->{owner} == $_->{label},
3195	values %{ $self->{item} };	4219	values %{ $self->{item} };
3196		4220
3197	while (my ($k, $v) = each %{ $self->{item} }) {	4221	while (my ($k, $v) = each %{ $self->{item} }) {
3198	delete $self->{item}{$k} if $v->{timeout} < $NOW;	4222	delete $self->{item}{$k} if $v->{timeout} < $NOW;
3199	}	4223	}
		4224
		4225	$self->{timer}->set (1, 1);
3200		4226
3201	my @widgets;	4227	my @widgets;
3202		4228
3203	my @items = sort {	4229	my @items = sort {
3204	$a->{pri} <=> $b->{pri}	4230	$a->{pri} <=> $b->{pri}
3205	or $b->{id} <=> $a->{id}	4231	or $b->{id} <=> $a->{id}
3206	} values %{ $self->{item} };	4232	} values %{ $self->{item} };
3207
3208	$self->{timer}->interval (1);
3209		4233
3210	my $count = 10 + 1;	4234	my $count = 10 + 1;
3211	for my $item (@items) {	4235	for my $item (@items) {
3212	last unless --$count;	4236	last unless --$count;
3213		4237
…		…
3220	for ($short) {	4244	for ($short) {
3221	s/^\s+//;	4245	s/^\s+//;
3222	s/\s+/ /g;	4246	s/\s+/ /g;
3223	}	4247	}
3224		4248
3225	new CFClient::UI::Label	4249	new DC::UI::Label
3226	markup => $short,	4250	markup => $short,
3227	tooltip => $item->{tooltip},	4251	tooltip => $item->{tooltip},
3228	tooltip_font => $::FONT_PROP,	4252	tooltip_font => $::FONT_PROP,
3229	tooltip_width => 0.67,	4253	tooltip_width => 0.67,
3230	fontsize => $item->{fontsize} || $self->{fontsize},	4254	fontsize => $item->{fontsize} || $self->{fontsize},
3231	max_w => $::WIDTH * 0.44,	4255	max_w => $::WIDTH * 0.44,
		4256	align => 0,
3232	fg => [@{ $item->{fg} }],	4257	fg => [@{ $item->{fg} }],
3233	can_events => 1,	4258	can_events => 1,
3234	can_hover => 1	4259	can_hover => 1
3235	};	4260	};
3236		4261
3237	if ((my $diff = $item->{timeout} - $NOW) < 2) {	4262	if ((my $diff = $item->{timeout} - $NOW) < 2) {
3238	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;	4263	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
3239	$label->update;	4264	$label->update;
3240	$label->set_max_size (undef, $label->{req_h} * $diff)	4265	$label->set_max_size (undef, $label->{req_h} * $diff)
3241	if $diff < 1;	4266	if $diff < 1;
3242	$self->{timer}->interval (1/30);	4267	$self->{timer}->set (1/30, 1/30);
3243	} else {	4268	} else {
3244	$label->{fg}[3] = $item->{fg}[3] || 1;	4269	$label->{fg}[3] = $item->{fg}[3] || 1;
3245	}	4270	}
3246		4271
3247	push @widgets, $label;	4272	push @widgets, $label;
…		…
3284	count => 1,	4309	count => 1,
3285	%arg,	4310	%arg,
3286	};	4311	};
3287	}	4312	}
3288		4313
		4314	$ROOT->on_refresh (reorder => sub {
3289	$self->reorder;	4315	$self->reorder;
		4316	});
3290	}	4317	}
3291		4318
3292	sub reconfigure {	4319	sub reconfigure {
3293	my ($self) = @_;	4320	my ($self) = @_;
3294		4321
…		…
3307	$self->SUPER::destroy;	4334	$self->SUPER::destroy;
3308	}	4335	}
3309		4336
3310	#############################################################################	4337	#############################################################################
3311		4338
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;	4339	package DC::UI::Root;
3674		4340
3675	our @ISA = CFClient::UI::Container::;	4341	our @ISA = DC::UI::Container::;
3676		4342
3677	use List::Util qw(min max);	4343	use List::Util qw(min max);
3678		4344
3679	use CFClient::OpenGL;	4345	use DC::OpenGL;
3680		4346
3681	sub new {	4347	sub new {
3682	my $class = shift;	4348	my $class = shift;
3683		4349
3684	my $self = $class->SUPER::new (	4350	my $self = $class->SUPER::new (
3685	visible => 1,	4351	visible => 1,
3686	@_,	4352	@_,
3687	);	4353	);
3688		4354
3689	Scalar::Util::weaken ($self->{root} = $self);	4355	DC::weaken ($self->{root} = $self);
3690		4356
3691	$self	4357	$self
3692	}	4358	}
3693		4359
3694	sub size_request {	4360	sub size_request {
…		…
3709	$coord = $max - $size if $coord > $max - $size;	4375	$coord = $max - $size if $coord > $max - $size;
3710		4376
3711	int $coord + 0.5	4377	int $coord + 0.5
3712	}	4378	}
3713		4379
3714	sub size_allocate {	4380	sub invoke_size_allocate {
3715	my ($self, $w, $h) = @_;	4381	my ($self, $w, $h) = @_;
3716		4382
3717	for my $child ($self->children) {	4383	for my $child ($self->children) {
3718	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	4384	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3719		4385
…		…
3723	$X = _to_pixel $X, $W, $self->{w};	4389	$X = _to_pixel $X, $W, $self->{w};
3724	$Y = _to_pixel $Y, $H, $self->{h};	4390	$Y = _to_pixel $Y, $H, $self->{h};
3725		4391
3726	$child->configure ($X, $Y, $W, $H);	4392	$child->configure ($X, $Y, $W, $H);
3727	}	4393	}
		4394
		4395	1
3728	}	4396	}
3729		4397
3730	sub coord2local {	4398	sub coord2local {
3731	my ($self, $x, $y) = @_;	4399	my ($self, $x, $y) = @_;
3732		4400
…		…
3740	}	4408	}
3741		4409
3742	sub update {	4410	sub update {
3743	my ($self) = @_;	4411	my ($self) = @_;
3744		4412
3745	$::WANT_REFRESH++;	4413	$::WANT_REFRESH = 1;
3746	}	4414	}
3747		4415
3748	sub add {	4416	sub add {
3749	my ($self, @children) = @_;	4417	my ($self, @children) = @_;
3750		4418
…		…
3787	while ($self->{refresh_hook}) {	4455	while ($self->{refresh_hook}) {
3788	$_->()	4456	$_->()
3789	for values %{delete $self->{refresh_hook}};	4457	for values %{delete $self->{refresh_hook}};
3790	}	4458	}
3791		4459
3792	if ($self->{realloc}) {	4460	while ($self->{realloc}) {
3793	my %queue;	4461	my %queue;
3794	my @queue;	4462	my @queue;
3795	my $widget;	4463	my $widget;
3796		4464
3797	outer:	4465	outer:
…		…
3817		4485
3818	delete $queue{$widget+0};	4486	delete $queue{$widget+0};
3819		4487
3820	my ($w, $h) = $widget->size_request;	4488	my ($w, $h) = $widget->size_request;
3821		4489
3822	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;	4490	$w += $widget->{padding_x} * 2;
3823	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;	4491	$h += $widget->{padding_y} * 2;
		4492
		4493	$w = max $widget->{min_w}, $w;
		4494	$h = max $widget->{min_h}, $h;
3824		4495
3825	$w = min $widget->{max_w}, $w if exists $widget->{max_w};	4496	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
3826	$h = min $widget->{max_h}, $h if exists $widget->{max_h};	4497	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3827		4498
3828	$w = $widget->{force_w} if exists $widget->{force_w};	4499	$w = $widget->{force_w} if exists $widget->{force_w};
…		…
3844	}	4515	}
3845	}	4516	}
3846		4517
3847	delete $self->{realloc}{$widget+0};	4518	delete $self->{realloc}{$widget+0};
3848	}	4519	}
3849	}
3850		4520
3851	while (my $size_alloc = delete $self->{size_alloc}) {	4521	while (my $size_alloc = delete $self->{size_alloc}) {
3852	my @queue = sort { $b->{visible} <=> $a->{visible} }	4522	my @queue = sort { $a->{visible} <=> $b->{visible} }
3853	values %$size_alloc;	4523	values %$size_alloc;
3854		4524
3855	while () {	4525	while () {
3856	my $widget = pop @queue || last;	4526	my $widget = pop @queue || last;
3857		4527
3858	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	4528	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3859		4529
3860	$w = 0 if $w < 0;	4530	$w = max $widget->{min_w}, $w;
3861	$h = 0 if $h < 0;	4531	$h = max $widget->{min_h}, $h;
3862		4532
		4533	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		4534	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		4535
		4536	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		4537	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		4538
3863	$w = int $w + 0.5;	4539	$w = int $w + 0.5;
3864	$h = int $h + 0.5;	4540	$h = int $h + 0.5;
3865		4541
3866	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	4542	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3867	$widget->{old_w} = $widget->{w};	4543	$widget->{old_w} = $widget->{w};
3868	$widget->{old_h} = $widget->{h};	4544	$widget->{old_h} = $widget->{h};
3869		4545
3870	$widget->{w} = $w;	4546	$widget->{w} = $w;
3871	$widget->{h} = $h;	4547	$widget->{h} = $h;
3872		4548
3873	$widget->emit (size_allocate => $w, $h);	4549	$widget->emit (size_allocate => $w, $h);
		4550	}
3874	}	4551	}
3875	}	4552	}
3876	}	4553	}
3877		4554
3878	while ($self->{post_alloc_hook}) {	4555	while ($self->{post_alloc_hook}) {
3879	$_->()	4556	$_->()
3880	for values %{delete $self->{post_alloc_hook}};	4557	for values %{delete $self->{post_alloc_hook}};
3881	}	4558	}
3882
3883		4559
3884	glViewport 0, 0, $::WIDTH, $::HEIGHT;	4560	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3885	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	4561	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3886	glClear GL_COLOR_BUFFER_BIT;	4562	glClear GL_COLOR_BUFFER_BIT;
3887		4563
…		…
3890	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4566	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3891	glMatrixMode GL_MODELVIEW;	4567	glMatrixMode GL_MODELVIEW;
3892	glLoadIdentity;	4568	glLoadIdentity;
3893		4569
3894	{	4570	{
3895	package CFClient::UI::Base;	4571	package DC::UI::Base;
3896		4572
3897	($draw_x, $draw_y, $draw_w, $draw_h) =	4573	local ($draw_x, $draw_y, $draw_w, $draw_h) =
3898	(0, 0, $self->{w}, $self->{h});	4574	(0, 0, $self->{w}, $self->{h});
3899	}
3900		4575
3901	$self->_draw;	4576	$self->_draw;
		4577	}
3902	}	4578	}
3903		4579
3904	#############################################################################	4580	#############################################################################
3905		4581
3906	package CFClient::UI;	4582	package DC::UI;
3907		4583
3908	$ROOT = new CFClient::UI::Root;	4584	$ROOT = new DC::UI::Root;
3909	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4585	$TOOLTIP = new DC::UI::Tooltip z => 900;
3910		4586
3911	1	4587	1
3912		4588

Diff Legend

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