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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.60 by root, Tue Apr 11 13:14:36 2006 UTC vs.
Revision 1.76 by root, Tue Apr 11 21:24:09 2006 UTC

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

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.60 by root, Tue Apr 11 13:14:36 2006 UTC vs. Revision 1.76 by root, Tue Apr 11 21:24:09 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.60 by root, Tue Apr 11 13:14:36 2006 UTC vs.
Revision 1.76 by root, Tue Apr 11 21:24:09 2006 UTC