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

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

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.50 by root, Sun Apr 9 22:27:24 2006 UTC vs. Revision 1.72 by root, Tue Apr 11 18:00:45 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.50 by root, Sun Apr 9 22:27:24 2006 UTC vs.
Revision 1.72 by root, Tue Apr 11 18:00:45 2006 UTC