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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.56 by root, Mon Apr 10 22:16:34 2006 UTC vs.
Revision 1.75 by root, Tue Apr 11 20:44:49 2006 UTC

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

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.56 by root, Mon Apr 10 22:16:34 2006 UTC vs. Revision 1.75 by root, Tue Apr 11 20:44:49 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.56 by root, Mon Apr 10 22:16:34 2006 UTC vs.
Revision 1.75 by root, Tue Apr 11 20:44:49 2006 UTC