ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.312 by root, Fri Jun 23 23:54:30 2006 UTC vs.
Revision 1.439 by root, Sun Sep 16 13:04:36 2007 UTC

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

Diff Legend

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