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

Diff Legend

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