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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.43 by root, Sun Apr 9 22:12:11 2006 UTC vs.
Revision 1.66 by root, Tue Apr 11 14:36:02 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; # the widget with current focus	12	our ($FOCUS, $HOVER, $GRAB); # various widgets
		13
		14	our $TOPLEVEL;
		15	our $BUTTON_STATE;
13		16
14	# class methods for events	17	# class methods for events
15	sub feed_sdl_key_down_event { $FOCUS->key_down ($_[0]) if $FOCUS }	18	sub feed_sdl_key_down_event {
16	sub feed_sdl_key_up_event { $FOCUS->key_up ($_[0]) if $FOCUS }	19	$FOCUS->key_down ($_[0]) if $FOCUS;
		20	}
		21
		22	sub feed_sdl_key_up_event {
		23	$FOCUS->key_up ($_[0]) if $FOCUS;
		24	}
		25
17	sub feed_sdl_button_down_event { }	26	sub feed_sdl_button_down_event {
		27	my ($ev) = @_;
		28	my ($x, $y) = ($ev->motion_x, $ev->motion_y);
		29
		30	if (!$BUTTON_STATE) {
		31	my $widget = $TOPLEVEL->find_widget ($x, $y);
		32
		33	$GRAB = $widget;
		34	$GRAB->update if $GRAB;
		35	}
		36
		37	$BUTTON_STATE \|= 1 << ($ev->button - 1);
		38
		39	$GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB;
		40	}
		41
18	sub feed_sdl_button_up_event { }	42	sub feed_sdl_button_up_event {
		43	my ($ev) = @_;
		44	my ($x, $y) = ($ev->motion_x, $ev->motion_y);
		45
		46	my $widget = $GRAB \|\| $TOPLEVEL->find_widget ($x, $y);
		47
		48	$BUTTON_STATE &= ~(1 << ($ev->button - 1));
		49
		50	$GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB;
		51
		52	if (!$BUTTON_STATE) {
		53	my $grab = $GRAB; undef $GRAB;
		54	$grab->update if $grab;
		55	$GRAB->update if $GRAB;
		56	}
		57	}
		58
		59	sub feed_sdl_motion_event {
		60	my ($ev) = @_;
		61	my ($x, $y) = ($ev->motion_x, $ev->motion_y);
		62
		63	my $widget = $GRAB \|\| $TOPLEVEL->find_widget ($x, $y);
		64
		65	if ($widget != $HOVER) {
		66	my $hover = $HOVER; $HOVER = $widget;
		67
		68	$hover->update if $hover;
		69	$HOVER->update if $HOVER;
		70	}
		71
		72	$HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER;
		73	}
19		74
20	sub new {	75	sub new {
21	my $class = shift;	76	my $class = shift;
22		77
23	bless { @_ }, $class	78	bless {
		79	x => 0,
		80	y => 0,
		81	z => 0,
		82	@_
		83	}, $class
24	}	84	}
25		85
26	sub move {	86	sub move {
27	my ($self, $x, $y, $z) = @_;	87	my ($self, $x, $y, $z) = @_;
28	$self->{x} = $x;	88	$self->{x} = $x;
44		104
45	$self->{w} = $w;	105	$self->{w} = $w;
46	$self->{h} = $h;	106	$self->{h} = $h;
47	}	107	}
48		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
49	sub focus_in {	116	sub focus_in {
50	my ($widget) = @_;	117	my ($self) = @_;
51	$FOCUS = $widget;	118
		119	my $focus = $FOCUS; $FOCUS = $self;
		120	$focus->update if $focus;
		121	$FOCUS->update;
52	}	122	}
53		123
54	sub focus_out {	124	sub focus_out {
55	my ($widget) = @_;	125	my ($self) = @_;
56	}
57		126
58	sub key_down {	127	return unless $FOCUS == $self;
59	my ($widget, $sdlev) = @_;
60	}
61		128
62	sub key_up {	129	my $focus = $FOCUS; undef $FOCUS;
63	my ($widget, $sdlev) = @_;	130	$focus->update if $focus; #?
64	}	131	}
65		132
		133	sub mouse_motion { }
		134	sub button_up { }
66	sub button_down {	135	sub button_down { }
67	my ($widget, $sdlev) = @_;	136	sub key_down { }
68	}	137	sub key_up { }
69		138
70	sub button_up {
71	my ($widget, $sdlev) = @_;
72	}
73
74	sub w { $_[0]->{w} = $_[1] if $_[1]; $_[0]->{w} }	139	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
75	sub h { $_[0]->{h} = $_[1] if $_[1]; $_[0]->{h} }	140	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
76	sub x { $_[0]->{x} = $_[1] if $_[1]; $_[0]->{x} }	141	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
77	sub y { $_[0]->{y} = $_[1] if $_[1]; $_[0]->{y} }	142	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
78	sub z { $_[0]->{z} = $_[1] if $_[1]; $_[0]->{z} }	143	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
79		144
80	sub draw {	145	sub draw {
81	my ($self) = @_;	146	my ($self) = @_;
82		147
83	glPushMatrix;	148	glPushMatrix;
84	glTranslate $self->{x}, $self->{y}, 0;	149	glTranslate $self->{x}, $self->{y}, 0;
85	$self->_draw;	150	$self->_draw;
		151	if ($self == $HOVER) {
		152	glColor 1, 1, 1, 0.4;
		153	glEnable GL_BLEND;
		154	glBegin GL_QUADS;
		155	glVertex 0 , 0;
		156	glVertex $self->{w}, 0;
		157	glVertex $self->{w}, $self->{h};
		158	glVertex 0 , $self->{h};
		159	glEnd;
		160	glDisable GL_BLEND;
		161	}
86	glPopMatrix;	162	glPopMatrix;
87	}	163	}
88		164
89	sub _draw {	165	sub _draw {
90	my ($self) = @_;	166	my ($self) = @_;
…		…
139	#$self->deactivate;	215	#$self->deactivate;
140	}	216	}
141		217
142	#############################################################################	218	#############################################################################
143		219
		220	package CFClient::Widget::Empty;
		221
		222	our @ISA = CFClient::Widget::;
		223
		224	sub size_request {
		225	(0, 0)
		226	}
		227
		228	sub draw {
		229	}
		230
		231	#############################################################################
		232
144	package Crossfire::Client::Widget::Container;	233	package CFClient::Widget::Container;
145		234
146	our @ISA = Crossfire::Client::Widget::;	235	our @ISA = CFClient::Widget::;
147		236
148	sub new {	237	sub new {
149	my ($class, @widgets) = @_;	238	my ($class, %arg) = @_;
150		239
		240	my $children = delete $arg{children} \|\| [];
		241
151	my $self = $class->SUPER::new (children => []);	242	my $self = $class->SUPER::new (children => [], %arg);
152	$self->add ($_) for @widgets;	243	$self->add ($_) for @$children;
153		244
154	$self	245	$self
155	}	246	}
156		247
157	sub add {	248	sub add {
158	my ($self, $chld, $expand) = @_;	249	my ($self, $chld, $expand) = @_;
159		250
160	$chld->{expand} = $expand;	251	$chld->{expand} = $expand;
161	$chld->set_parent ($self);	252	$chld->set_parent ($self);
162		253
163	@{$self->{children}} =	254	$self->{children} = [
164	sort { $a->{z} <=> $b->{z} }	255	sort { $a->{z} <=> $b->{z} }
165	@{$self->{children}}, $chld;	256	@{$self->{children}}, $chld
		257	];
166		258
167	$self->size_allocate ($self->{w}, $self->{h})	259	$self->size_allocate ($self->{w}, $self->{h})
168	if $self->{w}; #TODO: check for "realised state"	260	if $self->{w}; #TODO: check for "realised state"
169	}	261	}
170		262
…		…
177	}	269	}
178		270
179	sub find_widget {	271	sub find_widget {
180	my ($self, $x, $y) = @_;	272	my ($self, $x, $y) = @_;
181		273
		274	$x -= $self->{x};
		275	$y -= $self->{y};
		276
182	my $res;	277	my $res;
183		278
184	for (@{ $self->{children} }) {	279	for (reverse @{ $self->{children} }) {
185	$res = $_->find_widget ($x, $y)	280	$res = $_->find_widget ($x, $y)
186	and return $res;	281	and return $res;
187	}	282	}
188		283
189	()	284	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
190	}	285	}
191		286
192	sub _draw {	287	sub _draw {
193	my ($self) = @_;	288	my ($self) = @_;
194		289
195	$_->draw for @{$self->{children}};	290	$_->draw for @{$self->{children}};
196	}	291	}
197		292
198	#############################################################################	293	#############################################################################
199		294
200	package Crossfire::Client::Widget::Bin;	295	package CFClient::Widget::Bin;
201		296
202	our @ISA = Crossfire::Client::Widget::Container::;	297	our @ISA = CFClient::Widget::Container::;
		298
		299	sub new {
		300	my ($class, %arg) = @_;
		301
		302	my $child = (delete $arg{child}) \|\| new CFClient::Widget::Empty::;
		303
		304	$class->SUPER::new (children => [$child], %arg)
		305	}
		306
		307	sub add {
		308	my ($self, $widget) = @_;
		309
		310	$self->{children} = [];
		311
		312	$self->SUPER::add ($widget);
		313	}
		314
		315	sub remove {
		316	my ($self, $widget) = @_;
		317
		318	$self->SUPER::remove ($widget);
		319
		320	$self->{children} = [new CFClient::Widget::Empty]
		321	unless @{$self->{children}};
		322	}
203		323
204	sub child { $_[0]->{children}[0] }	324	sub child { $_[0]->{children}[0] }
205		325
206	sub size_request {	326	sub size_request {
207	$_[0]{children}[0]->size_request if $_[0]{children}[0];	327	$_[0]{children}[0]->size_request if $_[0]{children}[0];
…		…
215	if $self->{children}[0]	335	if $self->{children}[0]
216	}	336	}
217		337
218	#############################################################################	338	#############################################################################
219		339
220	package Crossfire::Client::Widget::Toplevel;	340	package CFClient::Widget::Window;
221		341
222	our @ISA = Crossfire::Client::Widget::Container::;	342	our @ISA = CFClient::Widget::Bin::;
		343
		344	use SDL::OpenGL;
		345
		346	sub new {
		347	my ($class, %arg) = @_;
		348
		349	my $self = $class->SUPER::new (%arg);
		350	}
223		351
224	sub update {	352	sub update {
225	my ($self) = @_;	353	my ($self) = @_;
226		354
227	::refresh ();	355	# we want to do this delayed...
228	}
229
230	sub add {
231	my ($self, $widget) = @_;
232
233	$self->SUPER::add ($widget);
234
235	$widget->size_allocate ($widget->size_request);
236	}
237
238	#############################################################################
239
240	package Crossfire::Client::Widget::Window;
241
242	our @ISA = Crossfire::Client::Widget::Bin::;
243
244	use SDL::OpenGL;
245
246	sub new {
247	my ($class, $x, $y, $z, $w, $h) = @_;
248
249	my $self = $class->SUPER::new;
250
251	@$self{qw(x y z w h)} = ($x, $y, $z, $w, $h);
252	}
253
254	sub update {
255	my ($self) = @_;
256
257	$self->render_chld;	356	$self->render_chld;
258	$self->SUPER::update;	357	$self->SUPER::update;
259	}	358	}
260		359
261	sub render_chld {	360	sub render_chld {
262	my ($self) = @_;	361	my ($self) = @_;
263		362
264	$self->{texture} =	363	$self->{texture} =
265	Crossfire::Client::Texture->new_from_opengl (	364	CFClient::Texture->new_from_opengl (
266	$self->{w}, $self->{h}, sub { $self->child->draw }	365	$self->{w}, $self->{h}, sub { $self->child->draw }
267	);	366	);
268	}	367	}
269		368
270	sub size_allocate {	369	sub size_allocate {
…		…
287	or return;	386	or return;
288		387
289	glEnable GL_BLEND;	388	glEnable GL_BLEND;
290	glEnable GL_TEXTURE_2D;	389	glEnable GL_TEXTURE_2D;
291	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	390	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
292	glBindTexture GL_TEXTURE_2D, $tex->{name};
293		391
294	glBegin GL_QUADS;	392	$tex->draw_quad (0, 0, $w, $h);
295	glTexCoord 0, 0; glVertex 0, 0;
296	glTexCoord 0, 1; glVertex 0, $h;
297	glTexCoord 1, 1; glVertex $w, $h;
298	glTexCoord 1, 0; glVertex $w, 0;
299	glEnd;
300		393
301	glDisable GL_BLEND;	394	glDisable GL_BLEND;
302	glDisable GL_TEXTURE_2D;	395	glDisable GL_TEXTURE_2D;
303	}	396	}
304		397
305	#############################################################################	398	#############################################################################
306		399
307	package Crossfire::Client::Widget::Frame;	400	package CFClient::Widget::Frame;
308		401
309	our @ISA = Crossfire::Client::Widget::Bin::;	402	our @ISA = CFClient::Widget::Bin::;
310		403
311	use SDL::OpenGL;	404	use SDL::OpenGL;
312		405
313	sub size_request {	406	sub size_request {
314	my ($self) = @_;	407	my ($self) = @_;
…		…
337		430
338	my ($w, $h) = $chld->size_request;	431	my ($w, $h) = $chld->size_request;
339		432
340	glBegin GL_QUADS;	433	glBegin GL_QUADS;
341	glColor 0, 0, 0;	434	glColor 0, 0, 0;
342	glTexCoord 0, 0; glVertex 0 , 0;	435	glVertex 0 , 0;
343	glTexCoord 0, 1; glVertex 0 , $h + 4;	436	glVertex 0 , $h + 4;
344	glTexCoord 1, 1; glVertex $w + 4 , $h + 4;	437	glVertex $w + 4 , $h + 4;
345	glTexCoord 1, 0; glVertex $w + 4 , 0;	438	glVertex $w + 4 , 0;
346	glEnd;	439	glEnd;
347		440
348	$chld->draw;	441	$chld->draw;
349	}	442	}
350		443
351	#############################################################################	444	#############################################################################
352		445
353	package Crossfire::Client::Widget::FancyFrame;	446	package CFClient::Widget::FancyFrame;
354		447
355	our @ISA = Crossfire::Client::Widget::Bin::;	448	our @ISA = CFClient::Widget::Bin::;
356		449
357	use SDL::OpenGL;	450	use SDL::OpenGL;
358		451
359	my @tex =	452	my @tex =
360	map { new_from_file Crossfire::Client::Texture Crossfire::Client::find_rcfile $_ }	453	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
361	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	454	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
362		455
363	sub size_request {	456	sub size_request {
364	my ($self) = @_;	457	my ($self) = @_;
365		458
…		…
384	$w -= $tex[3]->{width};	477	$w -= $tex[3]->{width};
385		478
386	$h = $h < 0 ? 0 : $h;	479	$h = $h < 0 ? 0 : $h;
387	$w = $w < 0 ? 0 : $w;	480	$w = $w < 0 ? 0 : $w;
388		481
		482	my $child = $self->child;
		483
389	$self->child->size_allocate ($w, $h);	484	$child->size_allocate ($w, $h);
390	$self->child->move ($tex[3]->{width}, $tex[1]->{height});	485	$child->move ($tex[3]->{width}, $tex[1]->{height});
391	}	486	}
392		487
393	sub _draw {	488	sub _draw {
394	my ($self) = @_;	489	my ($self) = @_;
395		490
…		…
400	glEnable GL_TEXTURE_2D;	495	glEnable GL_TEXTURE_2D;
401	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	496	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
402	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	497	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
403		498
404	my $top = $tex[1];	499	my $top = $tex[1];
405	glBindTexture GL_TEXTURE_2D, $top->{name};	500	$top->draw_quad (0, 0, $w, $top->{height});
406
407	glBegin GL_QUADS;
408	glTexCoord 0, 0; glVertex 0 , 0;
409	glTexCoord 0, 1; glVertex 0 , $top->{height};
410	glTexCoord 1, 1; glVertex $w , $top->{height};
411	glTexCoord 1, 0; glVertex $w , 0;
412	glEnd;
413		501
414	my $left = $tex[3];	502	my $left = $tex[3];
415	glBindTexture GL_TEXTURE_2D, $left->{name};	503	$left->draw_quad (0, $top->{height}, $left->{width}, $ch);
416
417	glBegin GL_QUADS;
418	glTexCoord 0, 0; glVertex 0 , $top->{height};
419	glTexCoord 0, 1; glVertex 0 , $top->{height} + $ch;
420	glTexCoord 1, 1; glVertex $left->{width}, $top->{height} + $ch;
421	glTexCoord 1, 0; glVertex $left->{width}, $top->{height};
422	glEnd;
423		504
424	my $right = $tex[2];	505	my $right = $tex[2];
425	glBindTexture GL_TEXTURE_2D, $right->{name};	506	$right->draw_quad ($w - $right->{width}, $top->{height}, $right->{width}, $ch);
426
427	glBegin GL_QUADS;
428	glTexCoord 0, 0; glVertex $w - $right->{width}, $top->{height};
429	glTexCoord 0, 1; glVertex $w - $right->{width}, $top->{height} + $ch;
430	glTexCoord 1, 1; glVertex $w , $top->{height} + $ch;
431	glTexCoord 1, 0; glVertex $w , $top->{height};
432	glEnd;
433		507
434	my $bottom = $tex[4];	508	my $bottom = $tex[4];
435	glBindTexture GL_TEXTURE_2D, $bottom->{name};	509	$bottom->draw_quad (0, $h - $bottom->{height}, $w, $bottom->{height});
436
437	glBegin GL_QUADS;
438	glTexCoord 0, 0; glVertex 0 , $h - $bottom->{height};
439	glTexCoord 0, 1; glVertex 0 , $h;
440	glTexCoord 1, 1; glVertex $w , $h;
441	glTexCoord 1, 0; glVertex $w , $h - $bottom->{height};
442	glEnd;
443		510
444	my $bg = $tex[0];	511	my $bg = $tex[0];
445	glBindTexture GL_TEXTURE_2D, $bg->{name};	512	glBindTexture GL_TEXTURE_2D, $bg->{name};
446	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	513	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
447	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;	514	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
448	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;	515	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
449		516
450	my $rep_x = $cw / $bg->{width};	517	my $rep_x = $cw / $bg->{width};
451	my $rep_y = $ch / $bg->{height};	518	my $rep_y = $ch / $bg->{height};
452		519
453	glBegin GL_QUADS;	520	$bg->draw_quad ($left->{width}, $top->{height}, $cw, $ch);
454	glTexCoord 0, 0; glVertex $left->{width}, $top->{height};
455	glTexCoord 0, $rep_y; glVertex $left->{width}, $top->{height} + $ch;
456	glTexCoord $rep_x, $rep_y; glVertex $left->{width} + $cw , $top->{height} + $ch;
457	glTexCoord $rep_x, 0; glVertex $left->{width} + $cw , $top->{height};
458	glEnd;
459		521
460	glDisable GL_BLEND;	522	glDisable GL_BLEND;
461	glDisable GL_TEXTURE_2D;	523	glDisable GL_TEXTURE_2D;
462		524
463	$self->child->draw;	525	$self->child->draw;
464		526
465	}	527	}
466		528
467	#############################################################################	529	#############################################################################
468		530
469	package Crossfire::Client::Widget::Table;	531	package CFClient::Widget::Table;
470		532
471	our @ISA = Crossfire::Client::Widget::Bin::;	533	our @ISA = CFClient::Widget::Bin::;
472		534
473	use SDL::OpenGL;	535	use SDL::OpenGL;
474		536
475	sub add {	537	sub add {
476	my ($self, $x, $y, $chld) = @_;	538	my ($self, $x, $y, $chld) = @_;
…		…
551	}	613	}
552	}	614	}
553		615
554	#############################################################################	616	#############################################################################
555		617
556	package Crossfire::Client::Widget::VBox;	618	package CFClient::Widget::VBox;
557		619
558	our @ISA = Crossfire::Client::Widget::Container::;	620	our @ISA = CFClient::Widget::Container::;
559		621
560	use SDL::OpenGL;	622	use SDL::OpenGL;
561		623
562	sub size_request {	624	sub size_request {
563	my ($self) = @_;	625	my ($self) = @_;
…		…
611	}	673	}
612	}	674	}
613		675
614	#############################################################################	676	#############################################################################
615		677
616	package Crossfire::Client::Widget::Label;	678	package CFClient::Widget::Label;
617		679
618	our @ISA = Crossfire::Client::Widget::;	680	our @ISA = CFClient::Widget::;
619		681
620	use SDL::OpenGL;	682	use SDL::OpenGL;
621		683
622	sub new {	684	sub new {
623	my ($class, $x, $y, $z, $height, $text) = @_;	685	my ($class, %arg) = @_;
624		686
625	# TODO: color, and make height, xyz etc. optional	687	# TODO: color, and make height, xyz etc. optional
626	my $self = $class->SUPER::new (x => $x, y => $y, z => $z, height => $height);	688	my $self = $class->SUPER::new (
		689	color => [1, 1, 1],
		690	height => $::FONTSIZE,
		691	text => "",
		692	layout => new CFClient::Layout,
		693	%arg
		694	);
627		695
628	$self->set_text ($text);	696	$self->set_text ($self->{text});
629		697
630	$self	698	$self
631	}	699	}
632		700
633	sub set_text {	701	sub set_text {
634	my ($self, $text) = @_;	702	my ($self, $text) = @_;
635		703
636	$self->{text} = $text;	704	$self->{text} = $text;
637	$self->{texture} = new_from_text Crossfire::Client::Texture $text, $self->{height};	705	$self->{layout}->set_markup ($text);
638		706
639	$self->update;	707	delete $self->{texture};
640	}	708	}
641		709
642	sub get_text {	710	sub get_text {
643	my ($self, $text) = @_;	711	my ($self, $text) = @_;
644		712
…		…
646	}	714	}
647		715
648	sub size_request {	716	sub size_request {
649	my ($self) = @_;	717	my ($self) = @_;
650		718
651	(	719	$self->{layout}->set_width;
		720	$self->{layout}->set_height ($self->{height});
		721	$self->{layout}->size
		722	# if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack
		723	# (
652	$self->{texture}{width},	724	# $self->{texture}{width},
653	$self->{texture}{height},	725	# $self->{texture}{height},
654	)	726	# )
		727	# } else {
		728	# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{height};
		729	#
		730	# ($w, $h)
		731	# }
		732	}
		733
		734	sub size_allocate {
		735	my ($self, $w, $h) = @_;
		736
		737	$self->SUPER::size_allocate ($w, $h);
		738	delete $self->{texture};
655	}	739	}
656		740
657	sub _draw {	741	sub _draw {
658	my ($self) = @_;	742	my ($self) = @_;
659		743
660	my $tex = $self->{texture};	744	my $tex = $self->{texture} \|\|= do {
		745	$self->{layout}->set_width ($self->{w});
		746	new_from_layout CFClient::Texture $self->{layout};
		747	};
661		748
662	glEnable GL_BLEND;	749	glEnable GL_BLEND;
663	glEnable GL_TEXTURE_2D;	750	glEnable GL_TEXTURE_2D;
664	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	751	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
665	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	752	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
666	glBindTexture GL_TEXTURE_2D, $tex->{name};
667		753
668	glColor 1, 0, 0, 1; # TODO color	754	glColor @{$self->{color}};
669		755
670	glBegin GL_QUADS;	756	$tex->draw_quad (0, 0);
671	glTexCoord 0, 0; glVertex 0 , 0;
672	glTexCoord 0, 1; glVertex 0 , $tex->{height};
673	glTexCoord 1, 1; glVertex $tex->{width}, $tex->{height};
674	glTexCoord 1, 0; glVertex $tex->{width}, 0;
675	glEnd;
676		757
677	glDisable GL_BLEND;	758	glDisable GL_BLEND;
678	glDisable GL_TEXTURE_2D;	759	glDisable GL_TEXTURE_2D;
679	}	760	}
680		761
681	#############################################################################	762	#############################################################################
682		763
683	package Crossfire::Client::Widget::TextEntry;	764	package CFClient::Widget::Entry;
684		765
685	our @ISA = Crossfire::Client::Widget::Label::;	766	our @ISA = CFClient::Widget::Label::;
686		767
687	use SDL;	768	use SDL;
688	use SDL::OpenGL;	769	use SDL::OpenGL;
689		770
690	sub key_down {	771	sub key_down {
691	my ($self, $ev) = @_;	772	my ($self, $ev) = @_;
692		773
693	my $mod = $ev->key_mod;	774	my $mod = $ev->key_mod;
694	my $sym = $ev->key_sym;	775	my $sym = $ev->key_sym;
695		776
696	$ev->set_unicode (1);
697	my $uni = $ev->key_unicode;	777	my $uni = $ev->key_unicode;
698		778
699	my $text = $self->get_text;	779	my $text = $self->get_text;
700		780
701	if ($sym == SDLK_BACKSPACE) {	781	if ($sym == SDLK_BACKSPACE) {
702	substr $text, -1, 1, '';	782	substr $text, -1, 1, '';
703
704	} elsif ($uni) {	783	} elsif ($uni) {
705	$text .= chr $uni;	784	$text .= chr $uni;
706	}	785	}
		786
707	$self->set_text ($text);	787	$self->set_text ($text);
708	}	788	}
709		789
710	#############################################################################	790	sub button_down {
		791	my ($self, $ev) = @_;
711		792
		793	$self->focus_in;
		794	}
		795
		796	sub mouse_motion {
		797	my ($self, $ev, $x, $y) = @_;
		798	printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		799	}
		800
		801	sub _draw {
		802	my ($self) = @_;
		803
		804	if ($FOCUS == $self) {
		805	glColor 1, 1, 1;
		806	} else {
		807	glColor 0.7, 0.7, 0.7;
		808	}
		809
		810	glBegin GL_QUADS;
		811	glVertex 0 , 0;
		812	glVertex 0 , $self->{h} - 1;
		813	glVertex $self->{w} - 1, $self->{h} - 1;
		814	glVertex $self->{w} - 1, 0;
		815	glEnd;
		816
		817	$self->SUPER::_draw;
		818	}
		819
		820	#############################################################################
		821
712	package Crossfire::Client::Widget::MapWidget;	822	package CFClient::Widget::MapWidget;
713		823
714	use strict;	824	use strict;
715		825
716	use List::Util qw(min max);	826	use List::Util qw(min max);
717		827
718	use SDL;	828	use SDL;
719	use SDL::OpenGL;	829	use SDL::OpenGL;
720	use SDL::OpenGL::Constants;	830	use SDL::OpenGL::Constants;
721		831
722	our @ISA = Crossfire::Client::Widget::;	832	our @ISA = CFClient::Widget::;
		833
		834	sub new {
		835	my $class = shift;
		836
		837	$class->SUPER::new (
		838	z => -1,
		839	list => (glGenLists 1),
		840	@_
		841	)
		842	}
723		843
724	sub key_down {	844	sub key_down {
725	print "MAPKEYDOWN\n";	845	print "MAPKEYDOWN\n";
726	}	846	}
727		847
728	sub key_up {	848	sub key_up {
729	}	849	}
730		850
731	sub size_request {	851	sub size_request {
732		852	(
		853	1 + int $::WIDTH / 32,
		854	1 + int $::HEIGHT / 32,
		855	)
733	}	856	}
734		857
735	sub size_allocate {	858	sub update {
		859	my ($self) = @_;
		860
		861	$self->{need_update} = 1;
736	}	862	}
737		863
738	sub _draw {	864	sub _draw {
739	my ($self) = @_;	865	my ($self) = @_;
740		866
		867	if (delete $self->{need_update}) {
		868	glNewList $self->{list}, GL_COMPILE;
		869
741	my $mx = $::CONN->{mapx};	870	my $mx = $::CONN->{mapx};
742	my $my = $::CONN->{mapy};	871	my $my = $::CONN->{mapy};
743		872
744	my $map = $::CONN->{map};	873	my $map = $::CONN->{map};
745		874
746	my ($xofs, $yofs);	875	my ($xofs, $yofs);
747		876
748	my $sw = 1 + int $::WIDTH / 32;	877	my $sw = 1 + int $::WIDTH / 32;
749	my $sh = 1 + int $::HEIGHT / 32;	878	my $sh = 1 + int $::HEIGHT / 32;
750		879
751	if ($::CONN->{mapw} > $sw) {	880	if ($::CONN->{mapw} > $sw) {
752	$xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;	881	$xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;
753	} else {	882	} else {
754	$xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};	883	$xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
755	}	884	}
756		885
757	if ($::CONN->{maph} > $sh) {	886	if ($::CONN->{maph} > $sh) {
758	$yofs = $my + ($::CONN->{maph} - $sh) * 0.5;	887	$yofs = $my + ($::CONN->{maph} - $sh) * 0.5;
759	} else {	888	} else {
760	$yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};	889	$yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
761	}	890	}
762		891
763	glEnable GL_TEXTURE_2D;	892	glEnable GL_TEXTURE_2D;
764	glEnable GL_BLEND;	893	glEnable GL_BLEND;
765	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	894	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
766		895
767	my $sw4 = ($sw + 3) & ~3;	896	my $sw4 = ($sw + 3) & ~3;
768	my $lighting = "\x00" x ($sw4 * $sh);	897	my $darkness = "\x00" x ($sw4 * $sh);
769		898
770	for my $x (0 .. $sw - 1) {	899	for my $x (0 .. $sw - 1) {
		900	my $row = $map->[$x + $xofs];
771	for my $y (0 .. $sh - 1) {	901	for my $y (0 .. $sh - 1) {
772		902
773	my $cell = $map->[$x + $xofs][$y + $yofs]	903	my $cell = $row->[$y + $yofs]
774	or next;	904	or next;
775		905
776	my $darkness = $cell->[0] * (1 / 255);	906	my $dark = $cell->[0];
777	if ($darkness < 0) {	907	if ($dark < 0) {
778	$darkness = 0.15;	908	substr $darkness, $y * $sw4 + $x, 1, chr 224;
		909	} else {
		910	substr $darkness, $y * $sw4 + $x, 1, chr 255 - $dark;
779	}	911	}
780	substr $lighting, $y * $sw4 + $x, 1, chr 255 - $darkness * 255;
781		912
782	for my $num (grep $_, @$cell[1,2,3]) {	913	for my $num (grep $_, @$cell[1,2,3]) {
783	my $tex = $::CONN->{face}[$num]{texture} \|\| next;	914	my $tex = $::CONN->{face}[$num]{texture} \|\| next;
784		915
785	glBindTexture GL_TEXTURE_2D, $tex->{name};
786
787	my $w = $tex->{width};	916	my $w = $tex->{width};
788	my $h = $tex->{height};	917	my $h = $tex->{height};
789		918
790	my $px = ($x + 1) * 32 - $w;	919	$tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h);
791	my $py = ($y + 1) * 32 - $h;
792
793	glBegin GL_QUADS;
794	glTexCoord 0, 0; glVertex $px , $py;
795	glTexCoord 0, 1; glVertex $px , $py + $h;
796	glTexCoord 1, 1; glVertex $px + $w, $py + $h;
797	glTexCoord 1, 0; glVertex $px + $w, $py;
798	glEnd;	920	}
799	}	921	}
800	}	922	}
801	}
802		923
803	# if (1) { # higher quality darkness	924	# if (1) { # higher quality darkness
804	# $lighting =~ s/(.)/$1$1$1/gs;	925	# $lighting =~ s/(.)/$1$1$1/gs;
805	# my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;	926	# my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
806	#	927	#
…		…
808	#	929	#
809	# $lighting = $pb->get_pixels;	930	# $lighting = $pb->get_pixels;
810	# $lighting =~ s/(.)../$1/gs;	931	# $lighting =~ s/(.)../$1/gs;
811	# }	932	# }
812		933
813	$lighting = new Crossfire::Client::Texture
814	width => $sw4,
815	height => $sh,
816	data => $lighting,
817	internalformat => GL_ALPHA4,
818	format => GL_ALPHA;
819
820	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	934	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
821	glColor 0, 0, 0, 0.75;
822	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	935	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
823	glBindTexture GL_TEXTURE_2D, $lighting->{name};
824	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
825	glBegin GL_QUADS;
826	glTexCoord 0, 0; glVertex 0 , 0;
827	glTexCoord 0, 1; glVertex 0 , $sh * 32;
828	glTexCoord 1, 1; glVertex $sw4 * 32, $sh * 32;
829	glTexCoord 1, 0; glVertex $sw4 * 32, 0;
830	glEnd;
831		936
		937	$darkness = new CFClient::Texture
		938	width => $sw4,
		939	height => $sh,
		940	data => $darkness,
		941	internalformat => GL_ALPHA,
		942	format => GL_ALPHA;
		943
		944	glColor 0.45, 0.45, 0.45, 1;
		945	$darkness->draw_quad (0, 0, $sw4 * 32, $sh * 32);
		946
832	glDisable GL_TEXTURE_2D;	947	glDisable GL_TEXTURE_2D;
833	glDisable GL_BLEND;	948	glDisable GL_BLEND;
		949
		950	glEndList;
		951	}
		952
		953	glCallList $self->{list};
834	}	954	}
835		955
836	my %DIR = (	956	my %DIR = (
837	SDLK_KP8, [1, "north"],	957	SDLK_KP8, [1, "north"],
838	SDLK_KP9, [2, "northeast"],	958	SDLK_KP9, [2, "northeast"],
…		…
884	}	1004	}
885	}	1005	}
886		1006
887	#############################################################################	1007	#############################################################################
888		1008
889	package Crossfire::Client::Widget::Animator;	1009	package CFClient::Widget::Animator;
890		1010
891	use SDL::OpenGL;	1011	use SDL::OpenGL;
892		1012
893	our @ISA = Crossfire::Client::Widget::Bin::;	1013	our @ISA = CFClient::Widget::Bin::;
894		1014
895	sub moveto {	1015	sub moveto {
896	my ($self, $x, $y) = @_;	1016	my ($self, $x, $y) = @_;
897		1017
898	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	1018	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
899	$self->{speed} = 0.2;	1019	$self->{speed} = 0.001;
900	$self->{time} = 1;	1020	$self->{time} = 1;
901		1021
902	::animation_start $self;	1022	::animation_start $self;
903	}	1023	}
904		1024
…		…
919		1039
920	sub _draw {	1040	sub _draw {
921	my ($self) = @_;	1041	my ($self) = @_;
922		1042
923	glPushMatrix;	1043	glPushMatrix;
924	glRotate $self->{time} * 10000, 0, 1, 0;	1044	glRotate $self->{time} * 1000, 0, 1, 0;
925	$self->{children}[0]->draw;	1045	$self->{children}[0]->draw;
926	glPopMatrix;	1046	glPopMatrix;
927	}	1047	}
928		1048
929	1;	1049	#############################################################################
930		1050
		1051	package CFClient::Widget::Toplevel;
		1052
		1053	our @ISA = CFClient::Widget::Container::;
		1054
		1055	sub size_request {
		1056	($::WIDTH, $::HEIGHT)
		1057	}
		1058
		1059	sub size_allocate {
		1060	my ($self, $w, $h) = @_;
		1061
		1062	$self->SUPER::size_allocate ($w, $h);
		1063
		1064	$_->size_allocate ($_->size_request)
		1065	for @{$self->{children}};
		1066	}
		1067
		1068	sub translate {
		1069	my ($self, $x, $y) = @_;
		1070
		1071	($x, $y)
		1072	}
		1073
		1074	sub update {
		1075	my ($self) = @_;
		1076
		1077	$self->size_allocate ($self->size_request);
		1078	::refresh ();
		1079	}
		1080
		1081	sub add {
		1082	my ($self, $widget) = @_;
		1083
		1084	$self->SUPER::add ($widget);
		1085
		1086	$widget->size_allocate ($widget->size_request);
		1087	}
		1088
		1089	sub draw {
		1090	my ($self) = @_;
		1091
		1092	$self->_draw;
		1093	}
		1094
		1095	#############################################################################
		1096
		1097	package CFClient::Widget;
		1098
		1099	$TOPLEVEL = new CFClient::Widget::Toplevel;
		1100
		1101	1
		1102

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.43 by root, Sun Apr 9 22:12:11 2006 UTC vs. Revision 1.66 by root, Tue Apr 11 14:36:02 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.43 by root, Sun Apr 9 22:12:11 2006 UTC vs.
Revision 1.66 by root, Tue Apr 11 14:36:02 2006 UTC