[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.57 by root, Mon Apr 10 22:53:49 2006 UTC vs.
Revision 1.69 by root, Tue Apr 11 17:32:14 2006 UTC

…		…
1	package Crossfire::Client::Widget;	1	package CFClient::Widget;
2		2
3	use strict;	3	use strict;
4		4
5	use Scalar::Util;	5	use Scalar::Util;
6		6
7	use SDL::OpenGL;	7	use SDL::OpenGL;
8	use SDL::OpenGL::Constants;	8	use SDL::OpenGL::Constants;
9		9
10	use Crossfire::Client;	10	use CFClient;
11		11
12	our ($FOCUS, $HOVER, $GRAB); # various widgets	12	our ($FOCUS, $HOVER, $GRAB); # various widgets
13		13
14	our $TOPLEVEL;	14	our $TOPLEVEL;
15	our $BUTTON_STATE;	15	our $BUTTON_STATE;
34	$GRAB->update if $GRAB;	34	$GRAB->update if $GRAB;
35	}	35	}
36		36
37	$BUTTON_STATE \|= 1 << ($ev->button - 1);	37	$BUTTON_STATE \|= 1 << ($ev->button - 1);
38		38
39	$GRAB->button_down ($ev) if $GRAB;	39	$GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB;
40	}	40	}
41		41
42	sub feed_sdl_button_up_event {	42	sub feed_sdl_button_up_event {
43	my ($ev) = @_;	43	my ($ev) = @_;
44	my ($x, $y) = ($ev->motion_x, $ev->motion_y);	44	my ($x, $y) = ($ev->motion_x, $ev->motion_y);
45		45
46	my $widget = $GRAB \|\| $TOPLEVEL->find_widget ($x, $y);	46	my $widget = $GRAB \|\| $TOPLEVEL->find_widget ($x, $y);
47		47
48	$BUTTON_STATE &= ~(1 << ($ev->button - 1));	48	$BUTTON_STATE &= ~(1 << ($ev->button - 1));
		49
		50	$GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB;
49		51
50	if (!$BUTTON_STATE) {	52	if (!$BUTTON_STATE) {
51	my $grab = $GRAB; undef $GRAB;	53	my $grab = $GRAB; undef $GRAB;
52	$grab->update if $grab;	54	$grab->update if $grab;
53	$GRAB->update if $GRAB;	55	$GRAB->update if $GRAB;
…		…
65		67
66	$hover->update if $hover;	68	$hover->update if $hover;
67	$HOVER->update if $HOVER;	69	$HOVER->update if $HOVER;
68	}	70	}
69		71
70	$HOVER->mouse_motion ($ev) if $HOVER;	72	$HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER;
71	}	73	}
72		74
73	sub new {	75	sub new {
74	my $class = shift;	76	my $class = shift;
75		77
76	bless { @_ }, $class	78	bless {
		79	x => 0,
		80	y => 0,
		81	z => 0,
		82	@_
		83	}, $class
77	}	84	}
78		85
79	sub move {	86	sub move {
80	my ($self, $x, $y, $z) = @_;	87	my ($self, $x, $y, $z) = @_;
81	$self->{x} = $x;	88	$self->{x} = $x;
…		…
97		104
98	$self->{w} = $w;	105	$self->{w} = $w;
99	$self->{h} = $h;	106	$self->{h} = $h;
100	}	107	}
101		108
		109	# translate global koordinates to local coordinate system
		110	sub translate {
		111	my ($self, $x, $y) = @_;
		112
		113	$self->{parent}->translate ($x - $self->{x}, $y - $self->{y});
		114	}
		115
102	sub focus_in {	116	sub focus_in {
103	my ($self) = @_;	117	my ($self) = @_;
		118
		119	return if $FOCUS == $self;
104		120
105	my $focus = $FOCUS; $FOCUS = $self;	121	my $focus = $FOCUS; $FOCUS = $self;
106	$focus->update if $focus;	122	$focus->update if $focus;
107	$FOCUS->update;	123	$FOCUS->update;
108	}	124	}
…		…
116	$focus->update if $focus; #?	132	$focus->update if $focus; #?
117	}	133	}
118		134
119	sub mouse_motion { }	135	sub mouse_motion { }
120	sub button_up { }	136	sub button_up { }
121	sub button_down { }
122	sub key_down { }	137	sub key_down { }
123	sub key_up { }	138	sub key_up { }
		139
		140	sub button_down {
		141	my ($self, $ev, $x, $y) = @_;
		142
		143	$self->focus_in;
		144	}
124		145
125	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	146	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
126	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	147	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
127	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	148	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
128	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	149	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
129	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	150	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
130		151
131	sub draw {	152	sub draw {
132	my ($self) = @_;	153	my ($self) = @_;
		154
		155	return unless $self->{h} && $self->{w};
133		156
134	glPushMatrix;	157	glPushMatrix;
135	glTranslate $self->{x}, $self->{y}, 0;	158	glTranslate $self->{x}, $self->{y}, 0;
136	$self->_draw;	159	$self->_draw;
137	if ($self == $HOVER) {	160	if ($self == $HOVER) {
…		…
201	#$self->deactivate;	224	#$self->deactivate;
202	}	225	}
203		226
204	#############################################################################	227	#############################################################################
205		228
206	package Crossfire::Client::Widget::Container;	229	package CFClient::Widget::DrawBG;
207		230
208	our @ISA = Crossfire::Client::Widget::;	231	our @ISA = CFClient::Widget::;
		232
		233	use strict;
		234	use SDL::OpenGL;
209		235
210	sub new {	236	sub new {
		237	my $class = shift;
		238
		239	# range [value, low, high, page]
		240
		241	$class->SUPER::new (
		242	bg => [0, 0, 0, 0.4],
		243	active_bg => [1, 1, 1],
		244	@_
		245	)
		246	}
		247
		248	sub _draw {
		249	my ($self) = @_;
		250
		251	my ($w, $h) = @$self{qw(w h)};
		252
		253	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };
		254	glBegin GL_QUADS;
		255	glVertex 0 , 0;
		256	glVertex 0 , $h;
		257	glVertex $w, $h;
		258	glVertex $w, 0;
		259	glEnd;
		260	}
		261
		262	#############################################################################
		263
		264	package CFClient::Widget::Empty;
		265
		266	our @ISA = CFClient::Widget::;
		267
		268	sub size_request {
		269	(0, 0)
		270	}
		271
		272	sub draw { }
		273
		274	#############################################################################
		275
		276	package CFClient::Widget::Container;
		277
		278	our @ISA = CFClient::Widget::;
		279
		280	sub new {
211	my ($class, @widgets) = @_;	281	my ($class, %arg) = @_;
212		282
		283	my $children = delete $arg{children} \|\| [];
		284
213	my $self = $class->SUPER::new (children => []);	285	my $self = $class->SUPER::new (children => [], %arg);
214	$self->add ($_) for @widgets;	286	$self->add ($_) for @$children;
215		287
216	$self	288	$self
217	}	289	}
218		290
219	sub add {	291	sub add {
220	my ($self, $chld, $expand) = @_;	292	my ($self, $chld, $expand) = @_;
221		293
222	$chld->{expand} = $expand;	294	$chld->{expand} = $expand;
223	$chld->set_parent ($self);	295	$chld->set_parent ($self);
224		296
225	@{$self->{children}} =	297	$self->{children} = [
226	sort { $a->{z} <=> $b->{z} }	298	sort { $a->{z} <=> $b->{z} }
227	@{$self->{children}}, $chld;	299	@{$self->{children}}, $chld
		300	];
228		301
229	$self->size_allocate ($self->{w}, $self->{h})	302	$self->size_allocate ($self->{w}, $self->{h})
230	if $self->{w}; #TODO: check for "realised state"	303	if $self->{w}; #TODO: check for "realised state"
231	}	304	}
232		305
…		…
260	$_->draw for @{$self->{children}};	333	$_->draw for @{$self->{children}};
261	}	334	}
262		335
263	#############################################################################	336	#############################################################################
264		337
265	package Crossfire::Client::Widget::Bin;	338	package CFClient::Widget::Bin;
266		339
267	our @ISA = Crossfire::Client::Widget::Container::;	340	our @ISA = CFClient::Widget::Container::;
		341
		342	sub new {
		343	my ($class, %arg) = @_;
		344
		345	my $child = (delete $arg{child}) \|\| new CFClient::Widget::Empty::;
		346
		347	$class->SUPER::new (children => [$child], %arg)
		348	}
		349
		350	sub add {
		351	my ($self, $widget) = @_;
		352
		353	$self->{children} = [];
		354
		355	$self->SUPER::add ($widget);
		356	}
		357
		358	sub remove {
		359	my ($self, $widget) = @_;
		360
		361	$self->SUPER::remove ($widget);
		362
		363	$self->{children} = [new CFClient::Widget::Empty]
		364	unless @{$self->{children}};
		365	}
268		366
269	sub child { $_[0]->{children}[0] }	367	sub child { $_[0]->{children}[0] }
270		368
271	sub size_request {	369	sub size_request {
272	$_[0]{children}[0]->size_request if $_[0]{children}[0];	370	$_[0]{children}[0]->size_request
273	}	371	}
274		372
275	sub size_allocate {	373	sub size_allocate {
276	my ($self, $w, $h) = @_;	374	my ($self, $w, $h) = @_;
277		375
		376	return unless $self->{w} != $w \|\| $self->{h} != $h;
		377
278	$self->SUPER::size_allocate ($w, $h);	378	$self->SUPER::size_allocate ($w, $h);
279	$self->{children}[0]->size_allocate ($w, $h)	379	$self->{children}[0]->size_allocate ($w, $h);
280	if $self->{children}[0]
281	}	380	}
282		381
283	#############################################################################	382	#############################################################################
284		383
285	package Crossfire::Client::Widget::Window;	384	package CFClient::Widget::Window;
286		385
287	our @ISA = Crossfire::Client::Widget::Bin::;	386	our @ISA = CFClient::Widget::Bin::;
288		387
289	use SDL::OpenGL;	388	use SDL::OpenGL;
290		389
291	sub new {	390	sub new {
292	my ($class, $x, $y, $z, $w, $h) = @_;	391	my ($class, %arg) = @_;
293		392
294	my $self = $class->SUPER::new;	393	my $self = $class->SUPER::new (%arg);
295
296	@$self{qw(x y z w h)} = ($x, $y, $z, $w, $h);
297	}	394	}
298		395
299	sub update {	396	sub update {
300	my ($self) = @_;	397	my ($self) = @_;
301		398
		399	# we want to do this delayed...
302	$self->render_chld;	400	$self->render_chld;
303	$self->SUPER::update;	401	$self->SUPER::update;
304	}	402	}
305		403
306	sub render_chld {	404	sub render_chld {
307	my ($self) = @_;	405	my ($self) = @_;
308		406
309	$self->{texture} =	407	$self->{texture} =
310	Crossfire::Client::Texture->new_from_opengl (	408	CFClient::Texture->new_from_opengl (
311	$self->{w}, $self->{h}, sub { $self->child->draw }	409	$self->{w}, $self->{h}, sub { $self->child->draw }
312	);	410	);
313	}	411	}
314		412
315	sub size_allocate {	413	sub size_allocate {
316	my ($self, $w, $h) = @_;	414	my ($self, $w, $h) = @_;
		415
		416	return unless $self->{w} != $w \|\| $self->{h} != $h;
317		417
318	$self->{w} = $w;	418	$self->{w} = $w;
319	$self->{h} = $h;	419	$self->{h} = $h;
320		420
321	$self->child->size_allocate ($w, $h);	421	$self->child->size_allocate ($w, $h);
…		…
341	glDisable GL_TEXTURE_2D;	441	glDisable GL_TEXTURE_2D;
342	}	442	}
343		443
344	#############################################################################	444	#############################################################################
345		445
346	package Crossfire::Client::Widget::Frame;	446	package CFClient::Widget::Frame;
347		447
348	our @ISA = Crossfire::Client::Widget::Bin::;	448	our @ISA = CFClient::Widget::Bin::;
349		449
350	use SDL::OpenGL;	450	use SDL::OpenGL;
351		451
352	sub size_request {	452	sub size_request {
353	my ($self) = @_;	453	my ($self) = @_;
…		…
360	}	460	}
361		461
362	sub size_allocate {	462	sub size_allocate {
363	my ($self, $w, $h) = @_;	463	my ($self, $w, $h) = @_;
364		464
		465	return unless $self->{w} != $w \|\| $self->{h} != $h;
		466
365	$self->{w} = $w;	467	$self->{w} = $w;
366	$self->{h} = $h;	468	$self->{h} = $h;
367		469
368	$self->child->size_allocate ($w - 4, $h - 4);	470	$self->child->size_allocate ($w - 4, $h - 4);
369	$self->child->move (2, 2);	471	$self->child->move (2, 2);
…		…
387	$chld->draw;	489	$chld->draw;
388	}	490	}
389		491
390	#############################################################################	492	#############################################################################
391		493
392	package Crossfire::Client::Widget::FancyFrame;	494	package CFClient::Widget::FancyFrame;
393		495
394	our @ISA = Crossfire::Client::Widget::Bin::;	496	our @ISA = CFClient::Widget::Bin::;
395		497
396	use SDL::OpenGL;	498	use SDL::OpenGL;
397		499
398	my @tex =	500	my @tex =
399	map { new_from_file Crossfire::Client::Texture Crossfire::Client::find_rcfile $_ }	501	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
400	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	502	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
401		503
402	sub size_request {	504	sub size_request {
403	my ($self) = @_;	505	my ($self) = @_;
404		506
…		…
413	}	515	}
414		516
415	sub size_allocate {	517	sub size_allocate {
416	my ($self, $w, $h) = @_;	518	my ($self, $w, $h) = @_;
417		519
		520	return unless $self->{w} != $w \|\| $self->{h} != $h;
		521
418	$self->SUPER::size_allocate ($w, $h);	522	$self->SUPER::size_allocate ($w, $h);
419		523
420	$h -= $tex[1]->{height};	524	$h -= $tex[1]->{height};
421	$h -= $tex[4]->{height};	525	$h -= $tex[4]->{height};
422	$w -= $tex[2]->{width};	526	$w -= $tex[2]->{width};
423	$w -= $tex[3]->{width};	527	$w -= $tex[3]->{width};
424		528
425	$h = $h < 0 ? 0 : $h;	529	$h = $h < 0 ? 0 : $h;
426	$w = $w < 0 ? 0 : $w;	530	$w = $w < 0 ? 0 : $w;
427		531
		532	my $child = $self->child;
		533
428	$self->child->size_allocate ($w, $h);	534	$child->size_allocate ($w, $h);
429	$self->child->move ($tex[3]->{width}, $tex[1]->{height});	535	$child->move ($tex[3]->{width}, $tex[1]->{height});
430	}	536	}
431		537
432	sub _draw {	538	sub _draw {
433	my ($self) = @_;	539	my ($self) = @_;
434		540
…		…
470		576
471	}	577	}
472		578
473	#############################################################################	579	#############################################################################
474		580
475	package Crossfire::Client::Widget::Table;	581	package CFClient::Widget::Table;
476		582
477	our @ISA = Crossfire::Client::Widget::Bin::;	583	our @ISA = CFClient::Widget::Bin::;
478		584
479	use SDL::OpenGL;	585	use SDL::OpenGL;
480		586
481	sub add {	587	sub add {
482	my ($self, $x, $y, $chld) = @_;	588	my ($self, $x, $y, $chld) = @_;
…		…
557	}	663	}
558	}	664	}
559		665
560	#############################################################################	666	#############################################################################
561		667
562	package Crossfire::Client::Widget::VBox;	668	package CFClient::Widget::VBox;
563		669
564	our @ISA = Crossfire::Client::Widget::Container::;	670	our @ISA = CFClient::Widget::Container::;
565		671
566	use SDL::OpenGL;	672	use SDL::OpenGL;
567		673
568	sub size_request {	674	sub size_request {
569	my ($self) = @_;	675	my ($self) = @_;
…		…
577	}	683	}
578		684
579	sub size_allocate {	685	sub size_allocate {
580	my ($self, $w, $h) = @_;	686	my ($self, $w, $h) = @_;
581		687
		688	return unless $self->{w} != $w \|\| $self->{h} != $h;
		689
582	$self->w ($w);	690	$self->{w} = $w;
583	$self->h ($h);	691	$self->{h} = $h;
584		692
585	my $exp;	693	return unless $self->{h};
586	my @oth;	694
587	# find expand widget	695	my $children = $self->{children};
588	for (@{$self->{children}}) {	696
589	if ($_->{expand}) {	697	my @h = map +($_->size_request)[1], @$children;
590	$exp = $_;	698
591	last;	699	my $req_h = List::Util::sum @h;
		700
		701	if ($req_h > $h) {
		702	# ah well, not enough space
		703	$_ = $h[$_] * $h / $req_h for @h;
		704	} else {
		705	my @exp = grep $_->{expand}, @$children;
		706	@exp = @$children unless @exp;
		707
		708	my %exp = map +($_ => 1), @exp;
		709
		710	for (0 .. $#$children) {
		711	my $child = $children->[$_];
		712
		713	my $alloc_h = $h[$_];
		714	$alloc_h += ($h - $req_h) / @exp if $exp{$child};
		715	$h[$_] = $alloc_h;
592	}	716	}
593	push @oth, $_;
594	}
595
596	my ($ow, $oh);
597
598	# get sizes of other widgets
599	for (@oth) {
600	my ($w, $h) = $_->size_request;
601	$oh += $h;
602	if ($ow < $w) { $ow = $w }
603	}	717	}
604		718
605	my $y = 0;	719	my $y = 0;
606	for (@{$self->{children}}) {	720	for (0 .. $#$children) {
		721	my $child = $children->[$_];
		722	my $h = $h[$_];
607	$_->move (0, $y);	723	$child->move (0, $y);
608
609	if ($_ == $exp) {
610	$_->size_allocate ($w, $h - $oh);
611	$y += $h - $oh;
612	} else {
613	my ($cw, $h) = $_->size_request;
614	$_->size_allocate ($w, $h);	724	$child->size_allocate ($w, $h);
		725
615	$y += $h;	726	$y += $h;
616	}
617	}	727	}
618	}	728	}
619		729
620	#############################################################################	730	#############################################################################
621		731
622	package Crossfire::Client::Widget::Label;	732	package CFClient::Widget::Label;
623		733
624	our @ISA = Crossfire::Client::Widget::;	734	our @ISA = CFClient::Widget::;
625		735
626	use SDL::OpenGL;	736	use SDL::OpenGL;
627		737
628	sub new {	738	sub new {
629	my ($class, $x, $y, $z, $height, $text) = @_;	739	my ($class, %arg) = @_;
630		740
		741	my $self = $class->SUPER::new (
		742	fg => [1, 1, 1],
631	$height \|\|= $::FONTSIZE;	743	height => $::FONTSIZE,
		744	text => "",
		745	layout => new CFClient::Layout,
		746	%arg
		747	);
632		748
633	# TODO: color, and make height, xyz etc. optional
634	my $self = $class->SUPER::new (x => $x, y => $y, z => $z, height => $height);
635
636	$self->set_text ($text);	749	$self->set_text ($self->{text});
637		750
638	$self	751	$self
		752	}
		753
		754	sub escape_text {
		755	local $_ = $_[1];
		756
		757	s/&/&/g;
		758	s/>/>/g;
		759	s/</</g;
		760
		761	$_[1]
639	}	762	}
640		763
641	sub set_text {	764	sub set_text {
642	my ($self, $text) = @_;	765	my ($self, $text) = @_;
643		766
644	$self->{text} = $text;	767	$self->{text} = $text;
645	$self->{texture} = new_from_text Crossfire::Client::Texture $text, $self->{height};	768	$self->{layout}->set_markup ($text);
646		769
		770	delete $self->{texture};
647	$self->update;	771	$self->update;
648	}	772	}
649		773
650	sub get_text {	774	sub get_text {
651	my ($self, $text) = @_;	775	my ($self, $text) = @_;
…		…
654	}	778	}
655		779
656	sub size_request {	780	sub size_request {
657	my ($self) = @_;	781	my ($self) = @_;
658		782
		783	$self->{layout}->set_width;
		784	$self->{layout}->set_height ($self->{height});
		785	$self->{layout}->size
659	if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack	786	# if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack
660	(	787	# (
661	$self->{texture}{width},	788	# $self->{texture}{width},
662	$self->{texture}{height},	789	# $self->{texture}{height},
663	)	790	# )
664	} else {	791	# } else {
665	my ($w, $h, $data) = Crossfire::Client::font_render "Yy", $self->{height};	792	# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{height};
666		793	#
667	($w, $h)	794	# ($w, $h)
668	}	795	# }
		796	}
669		797
		798	sub size_allocate {
		799	my ($self, $w, $h) = @_;
		800
		801	return unless $self->{w} != $w \|\| $self->{h} != $h;
		802
		803	$self->SUPER::size_allocate ($w, $h);
		804	delete $self->{texture};
		805	}
		806
		807	sub update {
		808	my ($self) = @_;
		809
		810	delete $self->{texture};
		811	$self->SUPER::update;
670	}	812	}
671		813
672	sub _draw {	814	sub _draw {
673	my ($self) = @_;	815	my ($self) = @_;
674		816
675	my $tex = $self->{texture};	817	my $tex = $self->{texture} \|\|= do {
		818	$self->{layout}->set_width ($self->{w});
		819	new_from_layout CFClient::Texture $self->{layout};
		820	};
676		821
677	glEnable GL_BLEND;	822	glEnable GL_BLEND;
678	glEnable GL_TEXTURE_2D;	823	glEnable GL_TEXTURE_2D;
679	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	824	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
680	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	825	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
681		826
682	glColor 1, 0, 0, 1; # TODO color	827	glColor @{$self->{fg}};
683		828
684	$tex->draw_quad (0, 0);	829	$tex->draw_quad (0, 0);
685		830
686	glDisable GL_BLEND;	831	glDisable GL_BLEND;
687	glDisable GL_TEXTURE_2D;	832	glDisable GL_TEXTURE_2D;
688	}	833	}
689		834
690	#############################################################################	835	#############################################################################
691		836
692	package Crossfire::Client::Widget::Entry;	837	package CFClient::Widget::Entry;
693		838
694	our @ISA = Crossfire::Client::Widget::Label::;	839	our @ISA = CFClient::Widget::Label::;
695		840
696	use SDL;	841	use SDL;
697	use SDL::OpenGL;	842	use SDL::OpenGL;
698		843
		844	sub new {
		845	my $class = shift;
		846
		847	$class->SUPER::new (
		848	fg => [1, 1, 1],
		849	bg => [0, 0, 0, 0.4],
		850	active_bg => [1, 1, 1],
		851	active_fg => [0, 0, 0],
		852	@_
		853	)
		854	}
		855
		856	sub _set_text {
		857	my ($self, $text) = @_;
		858
		859	$self->{last_activity} = $::NOW;
		860
		861	$self->{text} = $text;
		862	$self->{layout}->set_width ($self->{w});
		863	$self->{layout}->set_markup ($self->escape_text ($text));
		864
		865	$text = substr $text, 0, $self->{cursor};
		866	utf8::encode $text;
		867
		868	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
		869	}
		870
		871	sub size_request {
		872	my ($self) = @_;
		873
		874	my ($w, $h) = $self->SUPER::size_request;
		875
		876	($w + 1, $h) # add 1 for cursor
		877	}
		878
		879	sub size_allocate {
		880	my ($self, $w, $h) = @_;
		881
		882	return unless $self->{w} != $w \|\| $self->{h} != $h;
		883
		884	$self->SUPER::size_allocate ($w, $h);
		885
		886	$self->_set_text ($self->{text});
		887	}
		888
		889	sub set_text {
		890	my ($self, $text) = @_;
		891
		892	$self->{cursor} = length $text;
		893	$self->_set_text ($text);
		894	$self->update;
		895	}
		896
699	sub key_down {	897	sub key_down {
700	my ($self, $ev) = @_;	898	my ($self, $ev) = @_;
701		899
702	my $mod = $ev->key_mod;	900	my $mod = $ev->key_mod;
703	my $sym = $ev->key_sym;	901	my $sym = $ev->key_sym;
…		…
705	my $uni = $ev->key_unicode;	903	my $uni = $ev->key_unicode;
706		904
707	my $text = $self->get_text;	905	my $text = $self->get_text;
708		906
709	if ($sym == SDLK_BACKSPACE) {	907	if ($sym == SDLK_BACKSPACE) {
710	substr $text, -1, 1, '';	908	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
		909	} elsif ($sym == SDLK_DELETE) {
		910	substr $text, $self->{cursor}, 1, "";
		911	} elsif ($sym == SDLK_LEFT) {
		912	--$self->{cursor} if $self->{cursor};
		913	} elsif ($sym == SDLK_RIGHT) {
		914	++$self->{cursor} if $self->{cursor} < length $self->{text};
711	} elsif ($uni) {	915	} elsif ($uni) {
712	$text .= chr $uni;	916	substr $text, $self->{cursor}++, 0, chr $uni;
713	print "$uni <$text>\n";#d#
714	}	917	}
715		918
716	$self->set_text ($text);	919	$self->_set_text ($text);
		920	$self->update;
		921	}
		922
		923	sub focus_in {
		924	my ($self) = @_;
		925
		926	$self->{last_activity} = $::NOW;
		927
		928	$self->SUPER::focus_in;
717	}	929	}
718		930
719	sub button_down {	931	sub button_down {
720	my ($self, $ev) = @_;	932	my ($self, $ev, $x, $y) = @_;
721		933
722	$self->focus_in;	934	$self->SUPER::button_down ($ev, $x, $y);
		935
		936	my $idx = $self->{layout}->xy_to_index ($x, $y);
		937
		938	# byte-index to char-index
		939	my $text = $self->{layout};
		940	utf8::encode $text;
		941	$self->{cursor} = length substr $text, 0, $idx;
		942
		943	$self->_set_text ($self->{text});
		944	$self->update;
		945	}
		946
		947	sub mouse_motion {
		948	my ($self, $ev, $x, $y) = @_;
		949	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
723	}	950	}
724		951
725	sub _draw {	952	sub _draw {
726	my ($self) = @_;	953	my ($self) = @_;
727		954
		955	local $self->{fg} = $self->{fg};
		956
728	if ($FOCUS == $self) {	957	if ($FOCUS == $self) {
729	glColor 1, 1, 1;	958	glColor @{$self->{active_bg}};
		959	$self->{fg} = $self->{active_fg};
730	} else {	960	} else {
731	glColor 0.7, 0.7, 0.7;	961	glColor @{$self->{bg}};
732	}	962	}
733		963
734	glBegin GL_QUADS;	964	glBegin GL_QUADS;
735	glVertex 0 , 0;	965	glVertex 0 , 0;
736	glVertex 0 , $self->{h} - 1;	966	glVertex 0 , $self->{h};
737	glVertex $self->{w} - 1, $self->{h} - 1;	967	glVertex $self->{w}, $self->{h};
738	glVertex $self->{w} - 1, 0;	968	glVertex $self->{w}, 0;
739	glEnd;	969	glEnd;
740		970
741	$self->SUPER::_draw;	971	$self->SUPER::_draw;
742	}
743		972
744	#############################################################################	973	#TODO: force update every cursor change :(
		974	if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
		975	glColor @{$self->{fg}};
		976	glBegin GL_LINES;
		977	glVertex $self->{cur_x}, $self->{cur_y};
		978	glVertex $self->{cur_x}, $self->{cur_y} + $self->{cur_h};
		979	glEnd;
		980	}
		981	}
745		982
		983	#############################################################################
		984
		985	package CFClient::Widget::Slider;
		986
		987	use strict;
		988
		989	use SDL::OpenGL;
		990	use SDL::OpenGL::Constants;
		991
		992	our @ISA = CFClient::Widget::DrawBG::;
		993
		994	sub size_request {
		995	my ($self) = @_;
		996
		997	my $w = 20;
		998	my $h = 10;
		999
		1000	$self->{vertical} ? ($h, $w) : ($w, $h)
		1001	}
		1002
		1003	sub new {
		1004	my $class = shift;
		1005
		1006	# range [value, low, high, page]
		1007
		1008	$class->SUPER::new (
		1009	fg => [1, 1, 1],
		1010	active_fg => [0, 0, 0],
		1011	range => [0, 0, 100, 10],
		1012	vertical => 0,
		1013	@_
		1014	)
		1015	}
		1016
		1017	sub button_down {
		1018	my ($self, $ev, $x, $y) = @_;
		1019
		1020	$self->SUPER::button_down ($ev, $x, $y);
		1021	$self->mouse_motion ($ev, $x, $y);
		1022	}
		1023
		1024	sub mouse_motion {
		1025	my ($self, $ev, $x, $y) = @_;
		1026
		1027	if ($GRAB == $self) {
		1028	my ($value, $lo, $hi, $page) = @{$self->{range}};
		1029
		1030	$x = $x * ($hi - $lo) / $self->{w} + $lo;
		1031	$x = $lo if $x < $lo;
		1032	$x = $hi - $page if $x > $hi - $page;
		1033	$self->{range}[0] = $x;
		1034
		1035	$self->{changed}($x) if $self->{changed};
		1036	$self->update;
		1037	}
		1038	}
		1039
		1040	sub _draw {
		1041	my ($self) = @_;
		1042
		1043	$self->SUPER::_draw ();
		1044
		1045	glPushMatrix;
		1046
		1047	my ($w, $h) = @$self{qw(w h)};
		1048
		1049	if ($self->{vertical}) {
		1050	# draw a vertical slider like a rotated horizontal slider
		1051
		1052	glTranslate 0, $self->{w};
		1053	glRotate 90, 0, 0, 1;
		1054
		1055	($w, $h) = ($h, $w);
		1056	}
		1057
		1058	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
		1059	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
		1060
		1061	my ($value, $lo, $hi, $page) = @{$self->{range}};
		1062
		1063	$page = int $page * $w / ($hi - $lo);
		1064	$value = int +($value - $lo) * $w / ($hi - $lo);
		1065
		1066	$w -= $page;
		1067	$page &= ~1;
		1068	glTranslate $page * 0.5, 0, 0;
		1069
		1070	glColor @$fg;
		1071	glBegin GL_LINES;
		1072	glVertex 0, 0; glVertex 0, $h;
		1073	glVertex $w - 1, 0; glVertex $w - 1, $h;
		1074	glVertex 0, $h * 0.5; glVertex $w, $h * 0.5;
		1075	glEnd;
		1076
		1077	my $knob_a = $value - $page * 0.5;
		1078	my $knob_b = $value + $page * 0.5;
		1079
		1080	glBegin GL_QUADS;
		1081	glColor @$fg;
		1082	glVertex $knob_a, 0;
		1083	glVertex $knob_a, $h;
		1084	glVertex $knob_b, $h;
		1085	glVertex $knob_b, 0;
		1086
		1087	if ($knob_a < $knob_b - 2) {
		1088	glColor @$bg;
		1089	glVertex $knob_a + 1, 1;
		1090	glVertex $knob_a + 1, $h - 1;
		1091	glVertex $knob_b - 1, $h - 1;
		1092	glVertex $knob_b - 1, 1;
		1093	}
		1094	glEnd;
		1095
		1096	glPopMatrix;
		1097	}
		1098
		1099	#############################################################################
		1100
746	package Crossfire::Client::Widget::MapWidget;	1101	package CFClient::Widget::MapWidget;
747		1102
748	use strict;	1103	use strict;
749		1104
750	use List::Util qw(min max);	1105	use List::Util qw(min max);
751		1106
752	use SDL;	1107	use SDL;
753	use SDL::OpenGL;	1108	use SDL::OpenGL;
754	use SDL::OpenGL::Constants;	1109	use SDL::OpenGL::Constants;
755		1110
756	our @ISA = Crossfire::Client::Widget::;	1111	our @ISA = CFClient::Widget::;
		1112
		1113	sub new {
		1114	my $class = shift;
		1115
		1116	$class->SUPER::new (
		1117	z => -1,
		1118	list => (glGenLists 1),
		1119	@_
		1120	)
		1121	}
757		1122
758	sub key_down {	1123	sub key_down {
759	print "MAPKEYDOWN\n";	1124	print "MAPKEYDOWN\n";
760	}	1125	}
761		1126
…		…
767	1 + int $::WIDTH / 32,	1132	1 + int $::WIDTH / 32,
768	1 + int $::HEIGHT / 32,	1133	1 + int $::HEIGHT / 32,
769	)	1134	)
770	}	1135	}
771		1136
		1137	sub update {
		1138	my ($self) = @_;
		1139
		1140	$self->{need_update} = 1;
		1141	}
		1142
772	sub _draw {	1143	sub _draw {
773	my ($self) = @_;	1144	my ($self) = @_;
774		1145
		1146	if (delete $self->{need_update}) {
		1147	glNewList $self->{list}, GL_COMPILE;
		1148
775	my $mx = $::CONN->{mapx};	1149	my $mx = $::CONN->{mapx};
776	my $my = $::CONN->{mapy};	1150	my $my = $::CONN->{mapy};
777		1151
778	my $map = $::CONN->{map};	1152	my $map = $::CONN->{map};
779		1153
780	my ($xofs, $yofs);	1154	my ($xofs, $yofs);
781		1155
782	my $sw = 1 + int $::WIDTH / 32;	1156	my $sw = 1 + int $::WIDTH / 32;
783	my $sh = 1 + int $::HEIGHT / 32;	1157	my $sh = 1 + int $::HEIGHT / 32;
784		1158
785	if ($::CONN->{mapw} > $sw) {	1159	if ($::CONN->{mapw} > $sw) {
786	$xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;	1160	$xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;
787	} else {	1161	} else {
788	$xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};	1162	$xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
789	}	1163	}
790		1164
791	if ($::CONN->{maph} > $sh) {	1165	if ($::CONN->{maph} > $sh) {
792	$yofs = $my + ($::CONN->{maph} - $sh) * 0.5;	1166	$yofs = $my + ($::CONN->{maph} - $sh) * 0.5;
793	} else {	1167	} else {
794	$yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};	1168	$yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
795	}	1169	}
796		1170
797	glEnable GL_TEXTURE_2D;	1171	glEnable GL_TEXTURE_2D;
798	glEnable GL_BLEND;	1172	glEnable GL_BLEND;
799	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1173	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
800		1174
801	my $sw4 = ($sw + 3) & ~3;	1175	my $sw4 = ($sw + 3) & ~3;
802	my $darkness = "\x00" x ($sw4 * $sh);	1176	my $darkness = "\x00" x ($sw4 * $sh);
803		1177
804	for my $x (0 .. $sw - 1) {	1178	for my $x (0 .. $sw - 1) {
805	my $row = $map->[$x + $xofs];	1179	my $row = $map->[$x + $xofs];
806	for my $y (0 .. $sh - 1) {	1180	for my $y (0 .. $sh - 1) {
807		1181
808	my $cell = $row->[$y + $yofs]	1182	my $cell = $row->[$y + $yofs]
809	or next;	1183	or next;
810		1184
811	my $dark = $cell->[0];	1185	my $dark = $cell->[0];
812	if ($dark < 0) {	1186	if ($dark < 0) {
813	substr $darkness, $y * $sw4 + $x, 1, chr 224;	1187	substr $darkness, $y * $sw4 + $x, 1, chr 224;
814	} else {	1188	} else {
815	substr $darkness, $y * $sw4 + $x, 1, chr 255 - $dark;	1189	substr $darkness, $y * $sw4 + $x, 1, chr 255 - $dark;
816	}	1190	}
817		1191
818	for my $num (grep $_, @$cell[1,2,3]) {	1192	for my $num (grep $_, @$cell[1,2,3]) {
819	my $tex = $::CONN->{face}[$num]{texture} \|\| next;	1193	my $tex = $::CONN->{face}[$num]{texture} \|\| next;
820		1194
821	my $w = $tex->{width};	1195	my $w = $tex->{width};
822	my $h = $tex->{height};	1196	my $h = $tex->{height};
823		1197
824	$tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h);	1198	$tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h);
		1199	}
825	}	1200	}
826	}	1201	}
827	}
828		1202
829	# if (1) { # higher quality darkness	1203	# if (1) { # higher quality darkness
830	# $lighting =~ s/(.)/$1$1$1/gs;	1204	# $lighting =~ s/(.)/$1$1$1/gs;
831	# my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;	1205	# my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
832	#	1206	#
…		…
834	#	1208	#
835	# $lighting = $pb->get_pixels;	1209	# $lighting = $pb->get_pixels;
836	# $lighting =~ s/(.)../$1/gs;	1210	# $lighting =~ s/(.)../$1/gs;
837	# }	1211	# }
838		1212
839	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1213	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
840	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1214	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
841		1215
842	$darkness = new Crossfire::Client::Texture	1216	$darkness = new CFClient::Texture
843	width => $sw4,	1217	width => $sw4,
844	height => $sh,	1218	height => $sh,
845	data => $darkness,	1219	data => $darkness,
846	internalformat => GL_ALPHA,	1220	internalformat => GL_ALPHA,
847	format => GL_ALPHA;	1221	format => GL_ALPHA;
848		1222
849	glColor 0.45, 0.45, 0.45, 1;	1223	glColor 0.45, 0.45, 0.45, 1;
850	$darkness->draw_quad (0, 0, $sw4 * 32, $sh * 32);	1224	$darkness->draw_quad (0, 0, $sw4 * 32, $sh * 32);
851		1225
852	glDisable GL_TEXTURE_2D;	1226	glDisable GL_TEXTURE_2D;
853	glDisable GL_BLEND;	1227	glDisable GL_BLEND;
		1228
		1229	glEndList;
		1230	}
		1231
		1232	glCallList $self->{list};
854	}	1233	}
855		1234
856	my %DIR = (	1235	my %DIR = (
857	SDLK_KP8, [1, "north"],	1236	SDLK_KP8, [1, "north"],
858	SDLK_KP9, [2, "northeast"],	1237	SDLK_KP9, [2, "northeast"],
…		…
904	}	1283	}
905	}	1284	}
906		1285
907	#############################################################################	1286	#############################################################################
908		1287
909	package Crossfire::Client::Widget::Animator;	1288	package CFClient::Widget::Animator;
910		1289
911	use SDL::OpenGL;	1290	use SDL::OpenGL;
912		1291
913	our @ISA = Crossfire::Client::Widget::Bin::;	1292	our @ISA = CFClient::Widget::Bin::;
914		1293
915	sub moveto {	1294	sub moveto {
916	my ($self, $x, $y) = @_;	1295	my ($self, $x, $y) = @_;
917		1296
918	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	1297	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
923	}	1302	}
924		1303
925	sub animate {	1304	sub animate {
926	my ($self, $interval) = @_;	1305	my ($self, $interval) = @_;
927		1306
928	printf "%5.2f\n", 1 / $interval if $interval;#d#
929
930	$self->{time} -= $interval * $self->{speed};	1307	$self->{time} -= $interval * $self->{speed};
931	if ($self->{time} <= 0) {	1308	if ($self->{time} <= 0) {
932	$self->{time} = 0;	1309	$self->{time} = 0;
933	::animation_stop $self;	1310	::animation_stop $self;
934	}	1311	}
…		…
948	glPopMatrix;	1325	glPopMatrix;
949	}	1326	}
950		1327
951	#############################################################################	1328	#############################################################################
952		1329
953	package Crossfire::Client::Widget::Toplevel;	1330	package CFClient::Widget::Toplevel;
954		1331
955	our @ISA = Crossfire::Client::Widget::Container::;	1332	our @ISA = CFClient::Widget::Container::;
956		1333
957	sub size_request {	1334	sub size_request {
958	($::WIDTH, $::HEIGHT)	1335	($::WIDTH, $::HEIGHT)
959	}	1336	}
960		1337
…		…
965		1342
966	$_->size_allocate ($_->size_request)	1343	$_->size_allocate ($_->size_request)
967	for @{$self->{children}};	1344	for @{$self->{children}};
968	}	1345	}
969		1346
		1347	sub translate {
		1348	my ($self, $x, $y) = @_;
		1349
		1350	($x, $y)
		1351	}
		1352
970	sub update {	1353	sub update {
971	my ($self) = @_;	1354	my ($self) = @_;
972		1355
973	$self->size_allocate ($self->size_request);	1356	$self->size_allocate ($self->size_request);
974	::refresh ();	1357	::refresh ();
…		…
988	$self->_draw;	1371	$self->_draw;
989	}	1372	}
990		1373
991	#############################################################################	1374	#############################################################################
992		1375
993	package Crossfire::Client::Widget;	1376	package CFClient::Widget;
994		1377
995	$TOPLEVEL = new Crossfire::Client::Widget::Toplevel;	1378	$TOPLEVEL = new CFClient::Widget::Toplevel;
996		1379
997	1	1380	1
998		1381

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.57 by root, Mon Apr 10 22:53:49 2006 UTC vs. Revision 1.69 by root, Tue Apr 11 17:32:14 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.57 by root, Mon Apr 10 22:53:49 2006 UTC vs.
Revision 1.69 by root, Tue Apr 11 17:32:14 2006 UTC