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

Diff Legend

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