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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.72 by root, Tue Apr 11 18:00:45 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 {	84	bless {
79	x => 0,	85	x => 0,
80	y => 0,	86	y => 0,
81	z => 0,	87	z => 0,
		88	w => -1,
		89	h => -1,
82	@_	90	@_
83	}, $class	91	}, $class
84	}	92	}
85		93
86	sub move {	94	sub move {
…		…
97	sub size_request {	105	sub size_request {
98	require Carp;	106	require Carp;
99	Carp::confess "size_request is abtract";	107	Carp::confess "size_request is abtract";
100	}	108	}
101		109
102	sub size_allocate {	110	sub _size_allocate {
103	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;
104		117
105	$self->{w} = $w;	118	$self->{w} = $w;
106	$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);
107	}	128	}
108		129
109	# translate global koordinates to local coordinate system	130	# translate global koordinates to local coordinate system
110	sub translate {	131	sub translate {
111	my ($self, $x, $y) = @_;	132	my ($self, $x, $y) = @_;
…		…
158	glTranslate $self->{x}, $self->{y}, 0;	179	glTranslate $self->{x}, $self->{y}, 0;
159	$self->_draw;	180	$self->_draw;
160	glPopMatrix;	181	glPopMatrix;
161		182
162	if ($self == $HOVER) {	183	if ($self == $HOVER) {
163	my ($x, $y) = @$self->{qw(x y)};	184	my ($x, $y) = @$self{qw(x y)};
164		185
165	glColor 1, 1, 1, 0.1;	186	glColor 0, 0, 1, 0.2;
166	glEnable GL_BLEND;	187	glEnable GL_BLEND;
		188	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
167	glBegin GL_QUADS;	189	glBegin GL_QUADS;
168	glVertex $x , $y;	190	glVertex $x , $y;
169	glVertex $x + $self->{w}, $y;	191	glVertex $x + $self->{w}, $y;
170	glVertex $x + $self->{w}, $y + $self->{h};	192	glVertex $x + $self->{w}, $y + $self->{h};
171	glVertex $x , $y + $self->{h};	193	glVertex $x , $y + $self->{h};
…		…
240	#$self->deactivate;	262	#$self->deactivate;
241	}	263	}
242		264
243	#############################################################################	265	#############################################################################
244		266
245	package CFClient::Widget::DrawBG;	267	package CFClient::UI::DrawBG;
246		268
247	our @ISA = CFClient::Widget::;	269	our @ISA = CFClient::UI::Base::;
248		270
249	use strict;	271	use strict;
250	use SDL::OpenGL;	272	use SDL::OpenGL;
251		273
252	sub new {	274	sub new {
253	my $class = shift;	275	my $class = shift;
254		276
255	# range [value, low, high, page]	277	# range [value, low, high, page]
256		278
257	$class->SUPER::new (	279	$class->SUPER::new (
258	bg => [0, 0, 0, 0.4],	280	bg => [0, 0, 0, 0.2],
259	active_bg => [1, 1, 1],	281	active_bg => [1, 1, 1],
260	@_	282	@_
261	)	283	)
262	}	284	}
263		285
264	sub _draw {	286	sub _draw {
265	my ($self) = @_;	287	my ($self) = @_;
266		288
267	my ($w, $h) = @$self{qw(w h)};	289	my ($w, $h) = @$self{qw(w h)};
268		290
		291	glEnable GL_BLEND;
		292	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
269	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };	293	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };
		294
270	glBegin GL_QUADS;	295	glBegin GL_QUADS;
271	glVertex 0 , 0;	296	glVertex 0 , 0;
272	glVertex 0 , $h;	297	glVertex 0 , $h;
273	glVertex $w, $h;	298	glVertex $w, $h;
274	glVertex $w, 0;	299	glVertex $w, 0;
275	glEnd;	300	glEnd;
276	}
277		301
278	#############################################################################	302	glDisable GL_BLEND;
		303	}
279		304
		305	#############################################################################
		306
280	package CFClient::Widget::Empty;	307	package CFClient::UI::Empty;
281		308
282	our @ISA = CFClient::Widget::;	309	our @ISA = CFClient::UI::Base::;
283		310
284	sub size_request {	311	sub size_request {
285	(0, 0)	312	(0, 0)
286	}	313	}
287		314
288	sub draw { }	315	sub draw { }
289		316
290	#############################################################################	317	#############################################################################
291		318
292	package CFClient::Widget::Container;	319	package CFClient::UI::Container;
293		320
294	our @ISA = CFClient::Widget::;	321	our @ISA = CFClient::UI::Base::;
295		322
296	sub new {	323	sub new {
297	my ($class, %arg) = @_;	324	my ($class, %arg) = @_;
298		325
299	my $children = delete $arg{children} \|\| [];	326	my $children = delete $arg{children} \|\| [];
…		…
313	$self->{children} = [	340	$self->{children} = [
314	sort { $a->{z} <=> $b->{z} }	341	sort { $a->{z} <=> $b->{z} }
315	@{$self->{children}}, $chld	342	@{$self->{children}}, $chld
316	];	343	];
317		344
318	$self->size_allocate ($self->{w}, $self->{h})	345	$self->{w} = $self->{h} = -1;
319	if $self->{w}; #TODO: check for "realised state"	346	$self->update;
320	}	347	}
321		348
322	sub remove {	349	sub remove {
323	my ($self, $widget) = @_;	350	my ($self, $widget) = @_;
324		351
325	$self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];	352	$self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];
326		353
327	$self->size_allocate ($self->{w}, $self->{h});	354	$self->size_allocate (0, 0, $self->{w}, $self->{h});
328	}	355	}
329		356
330	sub find_widget {	357	sub find_widget {
331	my ($self, $x, $y) = @_;	358	my ($self, $x, $y) = @_;
332		359
…		…
349	$_->draw for @{$self->{children}};	376	$_->draw for @{$self->{children}};
350	}	377	}
351		378
352	#############################################################################	379	#############################################################################
353		380
354	package CFClient::Widget::Bin;	381	package CFClient::UI::Bin;
355		382
356	our @ISA = CFClient::Widget::Container::;	383	our @ISA = CFClient::UI::Container::;
357		384
358	sub new {	385	sub new {
359	my ($class, %arg) = @_;	386	my ($class, %arg) = @_;
360		387
361	my $child = (delete $arg{child}) \|\| new CFClient::Widget::Empty::;	388	my $child = (delete $arg{child}) \|\| new CFClient::UI::Empty::;
362		389
363	$class->SUPER::new (children => [$child], %arg)	390	$class->SUPER::new (children => [$child], %arg)
364	}	391	}
365		392
366	sub add {	393	sub add {
…		…
374	sub remove {	401	sub remove {
375	my ($self, $widget) = @_;	402	my ($self, $widget) = @_;
376		403
377	$self->SUPER::remove ($widget);	404	$self->SUPER::remove ($widget);
378		405
379	$self->{children} = [new CFClient::Widget::Empty]	406	$self->{children} = [new CFClient::UI::Empty]
380	unless @{$self->{children}};	407	unless @{$self->{children}};
381	}	408	}
382		409
383	sub child { $_[0]->{children}[0] }	410	sub child { $_[0]->{children}[0] }
384		411
385	sub size_request {	412	sub size_request {
386	$_[0]{children}[0]->size_request	413	$_[0]{children}[0]->size_request
387	}	414	}
388		415
389	sub size_allocate {	416	sub size_allocate {
390	my ($self, $w, $h) = @_;	417	my ($self, $x, $y, $w, $h) = @_;
391		418
392	return unless $self->{w} != $w \|\| $self->{h} != $h;	419	$self->_size_allocate ($x, $y, $w, $h) or return;
393		420
394	$self->SUPER::size_allocate ($w, $h);
395	$self->{children}[0]->size_allocate ($w, $h);	421	$self->{children}[0]->size_allocate (0, 0, $w, $h);
396	}	422	}
397		423
398	#############################################################################	424	#############################################################################
399		425
400	package CFClient::Widget::Window;	426	package CFClient::UI::Window;
401		427
402	our @ISA = CFClient::Widget::Bin::;	428	our @ISA = CFClient::UI::Bin::;
403		429
404	use SDL::OpenGL;	430	use SDL::OpenGL;
405		431
406	sub new {	432	sub new {
407	my ($class, %arg) = @_;	433	my ($class, %arg) = @_;
…		…
425	$self->{w}, $self->{h}, sub { $self->child->draw }	451	$self->{w}, $self->{h}, sub { $self->child->draw }
426	);	452	);
427	}	453	}
428		454
429	sub size_allocate {	455	sub size_allocate {
430	my ($self, $w, $h) = @_;	456	my ($self, $x, $y, $w, $h) = @_;
431		457
432	return unless $self->{w} != $w \|\| $self->{h} != $h;	458	$self->_size_allocate ($x, $y, $w, $h) or return;
433		459
434	$self->{w} = $w;
435	$self->{h} = $h;
436
437	$self->child->size_allocate ($w, $h);	460	$self->child->size_allocate (0, 0, $w, $h);
438		461
439	$self->render_chld;	462	$self->render_chld;
440	}	463	}
441		464
442	sub _draw {	465	sub _draw {
…		…
446		469
447	my $tex = $self->{texture}	470	my $tex = $self->{texture}
448	or return;	471	or return;
449		472
450	glEnable GL_BLEND;	473	glEnable GL_BLEND;
		474	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
451	glEnable GL_TEXTURE_2D;	475	glEnable GL_TEXTURE_2D;
452	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	476	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
453		477
454	$tex->draw_quad (0, 0, $w, $h);	478	$tex->draw_quad (0, 0, $w, $h);
455		479
…		…
457	glDisable GL_TEXTURE_2D;	481	glDisable GL_TEXTURE_2D;
458	}	482	}
459		483
460	#############################################################################	484	#############################################################################
461		485
462	package CFClient::Widget::Frame;	486	package CFClient::UI::Frame;
463		487
464	our @ISA = CFClient::Widget::Bin::;	488	our @ISA = CFClient::UI::Bin::;
465		489
466	use SDL::OpenGL;	490	use SDL::OpenGL;
467		491
468	sub size_request {	492	sub size_request {
469	my ($self) = @_;	493	my ($self) = @_;
…		…
474		498
475	map { $_ + 4 } $chld->size_request;	499	map { $_ + 4 } $chld->size_request;
476	}	500	}
477		501
478	sub size_allocate {	502	sub size_allocate {
479	my ($self, $w, $h) = @_;	503	my ($self, $x, $y, $w, $h) = @_;
480		504
481	return unless $self->{w} != $w \|\| $self->{h} != $h;	505	$self->_size_allocate ($x, $y, $w, $h) or return;
482		506
483	$self->{w} = $w;
484	$self->{h} = $h;
485
486	$self->child->size_allocate ($w - 4, $h - 4);	507	$self->child->size_allocate (2, 2, $w - 4, $h - 4);
487	$self->child->move (2, 2);
488	}	508	}
489		509
490	sub _draw {	510	sub _draw {
491	my ($self) = @_;	511	my ($self) = @_;
492		512
…		…
505	$chld->draw;	525	$chld->draw;
506	}	526	}
507		527
508	#############################################################################	528	#############################################################################
509		529
510	package CFClient::Widget::FancyFrame;	530	package CFClient::UI::FancyFrame;
511		531
512	our @ISA = CFClient::Widget::Bin::;	532	our @ISA = CFClient::UI::Bin::;
513		533
514	use SDL::OpenGL;	534	use SDL::OpenGL;
515		535
516	my @tex =	536	my @tex =
517	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	537	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
…		…
529		549
530	($w, $h)	550	($w, $h)
531	}	551	}
532		552
533	sub size_allocate {	553	sub size_allocate {
534	my ($self, $w, $h) = @_;	554	my ($self, $x, $y, $w, $h) = @_;
535		555
536	return unless $self->{w} != $w \|\| $self->{h} != $h;	556	$self->_size_allocate ($x, $y, $w, $h) or return;
537
538	$self->SUPER::size_allocate ($w, $h);
539		557
540	$h -= $tex[1]->{h};	558	$h -= $tex[1]->{h};
541	$h -= $tex[4]->{h};	559	$h -= $tex[4]->{h};
542	$w -= $tex[2]->{w};	560	$w -= $tex[2]->{w};
543	$w -= $tex[3]->{w};	561	$w -= $tex[3]->{w};
…		…
545	$h = $h < 0 ? 0 : $h;	563	$h = $h < 0 ? 0 : $h;
546	$w = $w < 0 ? 0 : $w;	564	$w = $w < 0 ? 0 : $w;
547		565
548	my $child = $self->child;	566	my $child = $self->child;
549		567
550	$child->size_allocate ($w, $h);
551	$child->move ($tex[3]->{w}, $tex[1]->{h});	568	$child->size_allocate ($tex[3]->{w}, $tex[1]->{h}, $w, $h);
552	}	569	}
553		570
554	sub _draw {	571	sub _draw {
555	my ($self) = @_;	572	my ($self) = @_;
556		573
557	my ($w, $h) = ($self->{w}, $self->{h});	574	my ($w, $h) = ($self->{w}, $self->{h});
558	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	575	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
559		576
560	glEnable GL_BLEND;	577	glEnable GL_BLEND;
		578	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
561	glEnable GL_TEXTURE_2D;	579	glEnable GL_TEXTURE_2D;
562	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
563	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	580	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
564		581
565	my $top = $tex[1];	582	my $top = $tex[1];
566	$top->draw_quad (0, 0, $w, $top->{h});	583	$top->draw_quad (0, 0, $w, $top->{h});
567		584
…		…
573		590
574	my $bottom = $tex[4];	591	my $bottom = $tex[4];
575	$bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h});	592	$bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h});
576		593
577	my $bg = $tex[0];	594	my $bg = $tex[0];
		595
578	glBindTexture GL_TEXTURE_2D, $bg->{name};	596	glBindTexture GL_TEXTURE_2D, $bg->{name};
579	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	597	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
580	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;	598	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
581	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;	599	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
582		600
583	my $rep_x = $cw / $bg->{w};	601	my $rep_x = $cw / $bg->{w};
584	my $rep_y = $ch / $bg->{h};	602	my $rep_y = $ch / $bg->{h};
585		603
586	$bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch);	604	$bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch);
587		605
		606	glDisable GL_TEXTURE_2D;
588	glDisable GL_BLEND;	607	glDisable GL_BLEND;
589	glDisable GL_TEXTURE_2D;
590		608
591	$self->child->draw;	609	$self->child->draw;
592		610
593	}	611	}
594		612
595	#############################################################################	613	#############################################################################
596		614
597	package CFClient::Widget::Table;	615	package CFClient::UI::Table;
598		616
599	our @ISA = CFClient::Widget::;	617	our @ISA = CFClient::UI::Base::;
		618
		619	use List::Util qw(max sum);
600		620
601	use SDL::OpenGL;	621	use SDL::OpenGL;
602		622
603	sub add {	623	sub add {
604	my ($self, $x, $y, $chld) = @_;	624	my ($self, $x, $y, $chld) = @_;
605	my $old_chld = $self->{children}[$y][$x];
606		625
607	$self->{children}[$y][$x] = $chld;	626	$self->{children}[$y][$x] = $chld;
608	$chld->set_parent ($self);	627	$chld->set_parent ($self);
		628
		629	$self->{w} = $self->{h} = -1;
609	$self->update;	630	$self->update;
610	}	631	}
611		632
612	sub max_row_height {	633	sub get_wh {
613	my ($self, $row) = @_;	634	my ($self) = @_;
614		635
615	my $hs = 0;	636	my (@w, @h);
616	for (my $xi = 0; $xi <= $#{$self->{children}->[$row] \|\| []}; $xi++) {	637
		638	for my $y (0 .. $#{$self->{children}}) {
617	my $c = $self->{children}->[$row]->[$xi];	639	my $row = $self->{children}[$y]
618	if ($c) {	640	or next;
		641
		642	for my $x (0 .. $#$row) {
		643	my $widget = $row->[$x]
		644	or next;
619	my ($w, $h) = $c->size_request;	645	my ($w, $h) = $widget->size_request;
620	if ($hs < $h) { $hs = $h }	646
		647	$w[$x] = max $w[$x], $w;
		648	$h[$y] = max $h[$y], $h;
621	}	649	}
622	}	650	}
623	return $hs;
624	}
625		651
626	sub max_col_width {	652	(\@w, \@h)
		653	}
		654
		655	sub size_request {
627	my ($self, $col) = @_;	656	my ($self) = @_;
628		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
629	my $ws = 0;	686	my $x = 0;
630	for (my $yi = 0; $yi <= $#{$self->{children} \|\| []}; $yi++) {	687	my $row_h = $hs->[$r];
631	my $c = ($self->{children}->[$yi] \|\| [])->[$col];	688
632	if ($c) {	689	for my $c (0 .. $#$row) {
633	my ($w, $h) = $c->size_request;	690	my $widget = $row->[$c]
634	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;
635	}	698	}
		699
		700	$y += $row_h;
636	}	701	}
637	return $ws;	702
638	}	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::;
639		736
640	sub size_request {	737	sub size_request {
641	my ($self) = @_;	738	my ($self) = @_;
642		739
643	my ($hs, $ws) = (0, 0);
644
645	for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
646	$hs += $self->max_row_height ($yi);
647	}
648
649	for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
650	my $wm = 0;
651	for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
652	$wm += $self->max_col_width ($xi)
653	}
654	if ($ws < $wm) { $ws = $wm }
655	}
656
657	return ($ws, $hs);
658	}
659
660	sub _draw {
661	my ($self) = @_;
662
663	my $y = 0;
664	for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
665	my $x = 0;
666
667	for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
668
669	my $c = $self->{children}->[$yi]->[$xi];
670	if ($c) {
671	$c->move ($x, $y, 0); #TODO: Move to size_request
672	$c->draw if $c;
673	}
674
675	$x += $self->max_col_width ($xi);
676	}
677
678	$y += $self->max_row_height ($yi);
679	}
680	}
681
682	#############################################################################
683
684	package CFClient::Widget::VBox;
685
686	our @ISA = CFClient::Widget::Container::;
687
688	use SDL::OpenGL;
689
690	sub size_request {
691	my ($self) = @_;
692
693	my @alloc = map [$_->size_request], @{$self->{children}};	740	my @alloc = map [$_->size_request], @{$self->{children}};
694		741
695	(	742	(
696	(List::Util::max map $_->[0], @alloc),
697	(List::Util::sum map $_->[1], @alloc),	743	(List::Util::sum map $_->[0], @alloc),
		744	(List::Util::max map $_->[1], @alloc),
698	)	745	)
699	}	746	}
700		747
701	sub size_allocate {	748	sub size_allocate {
702	my ($self, $w, $h) = @_;	749	my ($self, $x, $y, $w, $h) = @_;
703		750
704	return unless $self->{w} != $w \|\| $self->{h} != $h;	751	$self->_size_allocate ($x, $y, $w, $h) or return;
705		752
706	$self->{w} = $w;
707	$self->{h} = $h;
708
709	return unless $self->{h};	753	return unless $self->{w};
		754
		755	($h, $w) = ($w, $h);
710		756
711	my $children = $self->{children};	757	my $children = $self->{children};
712		758
713	my @h = map +($_->size_request)[1], @$children;	759	my @h = map +($_->size_request)[0], @$children;
714		760
715	my $req_h = List::Util::sum @h;	761	my $req_h = List::Util::sum @h;
716		762
717	if ($req_h > $h) {	763	if ($req_h > $h) {
718	# ah well, not enough space	764	# ah well, not enough space
…		…
734		780
735	my $y = 0;	781	my $y = 0;
736	for (0 .. $#$children) {	782	for (0 .. $#$children) {
737	my $child = $children->[$_];	783	my $child = $children->[$_];
738	my $h = $h[$_];	784	my $h = $h[$_];
739	$child->move (0, $y);
740	$child->size_allocate ($w, $h);	785	$child->size_allocate ($y, 0, $h, $w);
741		786
742	$y += $h;	787	$y += $h;
743	}	788	}
744	}	789	}
745		790
746	#############################################################################	791	#############################################################################
747		792
		793	package CFClient::UI::VBox;
		794
		795	# TODO: wrap into common Box base class
		796
		797	our @ISA = CFClient::UI::Container::;
		798
		799	sub size_request {
		800	my ($self) = @_;
		801
		802	my @alloc = map [$_->size_request], @{$self->{children}};
		803
		804	(
		805	(List::Util::max map $_->[0], @alloc),
		806	(List::Util::sum map $_->[1], @alloc),
		807	)
		808	}
		809
		810	sub size_allocate {
		811	my ($self, $x, $y, $w, $h) = @_;
		812
		813	$self->_size_allocate ($x, $y, $w, $h) or return;
		814
		815	return unless $self->{h};
		816
		817	my $children = $self->{children};
		818
		819	my @h = map +($_->size_request)[1], @$children;
		820
		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;
		838	}
		839	}
		840
		841	my $y = 0;
		842	for (0 .. $#$children) {
		843	my $child = $children->[$_];
		844	my $h = $h[$_];
		845	$child->size_allocate (0, $y, $w, $h);
		846
		847	$y += $h;
		848	}
		849	}
		850
		851	#############################################################################
		852
748	package CFClient::Widget::Label;	853	package CFClient::UI::Label;
749		854
750	our @ISA = CFClient::Widget::;	855	our @ISA = CFClient::UI::Base::;
751		856
752	use SDL::OpenGL;	857	use SDL::OpenGL;
753		858
754	sub new {	859	sub new {
755	my ($class, %arg) = @_;	860	my ($class, %arg) = @_;
756		861
757	my $self = $class->SUPER::new (	862	my $self = $class->SUPER::new (
758	fg => [1, 1, 1],	863	fg => [1, 1, 1],
759	height => $::FONTSIZE,	864	height => $::FONTSIZE,
760	text => "",	865	text => "",
761	align => -1,	866	align => -1,
		867	padding => 2,
762	layout => new CFClient::Layout,	868	layout => new CFClient::Layout,
763	%arg	869	%arg
764	);	870	);
765		871
766	$self->set_text ($self->{text});	872	$self->set_text ($self->{text});
767		873
…		…
797	sub size_request {	903	sub size_request {
798	my ($self) = @_;	904	my ($self) = @_;
799		905
800	$self->{layout}->set_width;	906	$self->{layout}->set_width;
801	$self->{layout}->set_height ($self->{height});	907	$self->{layout}->set_height ($self->{height});
802	$self->{layout}->size	908	my ($w, $h) = $self->{layout}->size;
803	# if ($self->{texture}{w} > 1 && $self->{texture}{height} > 1) { #TODO: hack	909
804	# (	910	(
805	# $self->{texture}{w},	911	$w + $self->{padding} * 2,
806	# $self->{texture}{h},	912	$h + $self->{padding} * 2,
807	# )	913	)
808	# } else {
809	# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{h};
810	#
811	# ($w, $h)
812	# }
813	}	914	}
814		915
815	sub size_allocate {	916	sub size_allocate {
816	my ($self, $w, $h) = @_;	917	my ($self, $x, $y, $w, $h) = @_;
817		918
818	return unless $self->{w} != $w \|\| $self->{h} != $h;	919	$self->_size_allocate ($x, $y, $w, $h) or return;
819		920
820	$self->SUPER::size_allocate ($w, $h);
821	delete $self->{texture};	921	delete $self->{texture};
822	}	922	}
823		923
824	sub update {	924	sub update {
825	my ($self) = @_;	925	my ($self) = @_;
…		…
831	sub _draw {	931	sub _draw {
832	my ($self) = @_;	932	my ($self) = @_;
833		933
834	my $tex = $self->{texture} \|\|= do {	934	my $tex = $self->{texture} \|\|= do {
835	$self->{layout}->set_width ($self->{w});	935	$self->{layout}->set_width ($self->{w});
836	new_from_layout CFClient::Texture $self->{layout};	936	new_from_layout CFClient::Texture $self->{layout}
837	};	937	};
838		938
839	glEnable GL_BLEND;	939	glEnable GL_BLEND;
		940	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
840	glEnable GL_TEXTURE_2D;	941	glEnable GL_TEXTURE_2D;
841	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
842	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	942	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
843		943
844	glColor @{$self->{fg}};	944	glColor @{$self->{fg}};
845		945
846	my $x =	946	my $x =
847	$self->{align} < 0 ? 0	947	$self->{align} < 0 ? $self->{padding}
848	: $self->{align} > 0 ? $self->{w} - $self->{texture}{w}	948	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
849	: ($self->{w} + $self->{texture}{w}) * 0.5;	949	: ($self->{w} - $tex->{w}) * 0.5;
850		950
851	$tex->draw_quad ($x, 0);	951	$tex->draw_quad ($x, 0);
852		952
		953	glDisable GL_TEXTURE_2D;
853	glDisable GL_BLEND;	954	glDisable GL_BLEND;
854	glDisable GL_TEXTURE_2D;
855	}	955	}
856		956
857	#############################################################################	957	#############################################################################
858		958
859	package CFClient::Widget::Entry;	959	package CFClient::UI::Entry;
860		960
861	our @ISA = CFClient::Widget::Label::;	961	our @ISA = CFClient::UI::Label::;
862		962
863	use SDL;	963	use SDL;
864	use SDL::OpenGL;	964	use SDL::OpenGL;
865		965
866	sub new {	966	sub new {
867	my $class = shift;	967	my $class = shift;
868		968
869	$class->SUPER::new (	969	$class->SUPER::new (
870	fg => [1, 1, 1],	970	fg => [1, 1, 1],
871	bg => [0, 0, 0, 0.4],	971	bg => [0, 0, 0, 0.2],
872	active_bg => [1, 1, 1],	972	active_bg => [1, 1, 1],
873	active_fg => [0, 0, 0],	973	active_fg => [0, 0, 0],
874	@_	974	@_
875	)	975	)
876	}	976	}
…		…
883	$self->{text} = $text;	983	$self->{text} = $text;
884	$self->{layout}->set_width ($self->{w});	984	$self->{layout}->set_width ($self->{w});
885		985
886	$text =~ s/./*/g if $self->{hidden};	986	$text =~ s/./*/g if $self->{hidden};
887		987
888
889	$self->{layout}->set_markup ($self->escape_text ($text));	988	$self->{layout}->set_markup ($self->escape_text ($text) . " ");
890		989
891	$text = substr $text, 0, $self->{cursor};	990	$text = substr $text, 0, $self->{cursor};
892	utf8::encode $text;	991	utf8::encode $text;
893		992
894	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);	993	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
…		…
901		1000
902	($w + 1, $h) # add 1 for cursor	1001	($w + 1, $h) # add 1 for cursor
903	}	1002	}
904		1003
905	sub size_allocate {	1004	sub size_allocate {
906	my ($self, $w, $h) = @_;	1005	my ($self, $x, $y, $w, $h) = @_;
907		1006
908	return unless $self->{w} != $w \|\| $self->{h} != $h;
909
910	$self->SUPER::size_allocate ($w, $h);	1007	$self->SUPER::size_allocate ($x, $y, $w, $h);
911		1008
912	$self->_set_text ($self->{text});	1009	$self->_set_text ($self->{text});
913	}	1010	}
914		1011
915	sub set_text {	1012	sub set_text {
…		…
936	substr $text, $self->{cursor}, 1, "";	1033	substr $text, $self->{cursor}, 1, "";
937	} elsif ($sym == SDLK_LEFT) {	1034	} elsif ($sym == SDLK_LEFT) {
938	--$self->{cursor} if $self->{cursor};	1035	--$self->{cursor} if $self->{cursor};
939	} elsif ($sym == SDLK_RIGHT) {	1036	} elsif ($sym == SDLK_RIGHT) {
940	++$self->{cursor} if $self->{cursor} < length $self->{text};	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;
941	} elsif ($uni) {	1042	} elsif ($uni) {
942	substr $text, $self->{cursor}++, 0, chr $uni;	1043	substr $text, $self->{cursor}++, 0, chr $uni;
943	}	1044	}
944		1045
945	$self->_set_text ($text);	1046	$self->_set_text ($text);
…		…
960	$self->SUPER::button_down ($ev, $x, $y);	1061	$self->SUPER::button_down ($ev, $x, $y);
961		1062
962	my $idx = $self->{layout}->xy_to_index ($x, $y);	1063	my $idx = $self->{layout}->xy_to_index ($x, $y);
963		1064
964	# byte-index to char-index	1065	# byte-index to char-index
965	my $text = $self->{layout};	1066	my $text = $self->{text};
966	utf8::encode $text;	1067	utf8::encode $text;
967	$self->{cursor} = length substr $text, 0, $idx;	1068	$self->{cursor} = length substr $text, 0, $idx;
968		1069
969	$self->_set_text ($self->{text});	1070	$self->_set_text ($self->{text});
970	$self->update;	1071	$self->update;
…		…
985	$self->{fg} = $self->{active_fg};	1086	$self->{fg} = $self->{active_fg};
986	} else {	1087	} else {
987	glColor @{$self->{bg}};	1088	glColor @{$self->{bg}};
988	}	1089	}
989		1090
		1091	glEnable GL_BLEND;
		1092	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
990	glBegin GL_QUADS;	1093	glBegin GL_QUADS;
991	glVertex 0 , 0;	1094	glVertex 0 , 0;
992	glVertex 0 , $self->{h};	1095	glVertex 0 , $self->{h};
993	glVertex $self->{w}, $self->{h};	1096	glVertex $self->{w}, $self->{h};
994	glVertex $self->{w}, 0;	1097	glVertex $self->{w}, 0;
995	glEnd;	1098	glEnd;
		1099	glDisable GL_BLEND;
996		1100
997	$self->SUPER::_draw;	1101	$self->SUPER::_draw;
998		1102
999	#TODO: force update every cursor change :(	1103	#TODO: force update every cursor change :(
1000	if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {	1104	if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
…		…
1006	}	1110	}
1007	}	1111	}
1008		1112
1009	#############################################################################	1113	#############################################################################
1010		1114
1011	package CFClient::Widget::Slider;	1115	package CFClient::UI::Slider;
1012		1116
1013	use strict;	1117	use strict;
1014		1118
1015	use SDL::OpenGL;	1119	use SDL::OpenGL;
1016	use SDL::OpenGL::Constants;
1017		1120
1018	our @ISA = CFClient::Widget::DrawBG::;	1121	our @ISA = CFClient::UI::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		1122
1029	sub new {	1123	sub new {
1030	my $class = shift;	1124	my $class = shift;
1031		1125
1032	# range [value, low, high, page]	1126	# range [value, low, high, page]
1033		1127
1034	$class->SUPER::new (	1128	my $self = $class->SUPER::new (
1035	fg => [1, 1, 1],	1129	fg => [1, 1, 1],
1036	active_fg => [0, 0, 0],	1130	active_fg => [0, 0, 0],
1037	range => [0, 0, 100, 10],	1131	range => [0, 0, 100, 10],
		1132	req_w => 40,
		1133	req_h => 10,
1038	vertical => 1,	1134	vertical => 0,
1039	@_	1135	@_
1040	)	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)
1041	}	1148	}
1042		1149
1043	sub button_down {	1150	sub button_down {
1044	my ($self, $ev, $x, $y) = @_;	1151	my ($self, $ev, $x, $y) = @_;
1045		1152
…		…
1120	glEnd;	1227	glEnd;
1121	}	1228	}
1122		1229
1123	#############################################################################	1230	#############################################################################
1124		1231
1125	package CFClient::Widget::MapWidget;	1232	package CFClient::UI::MapWidget;
1126		1233
1127	use strict;	1234	use strict;
1128		1235
1129	use List::Util qw(min max);	1236	use List::Util qw(min max);
1130		1237
1131	use SDL;	1238	use SDL;
1132	use SDL::OpenGL;	1239	use SDL::OpenGL;
1133	use SDL::OpenGL::Constants;
1134		1240
1135	our @ISA = CFClient::Widget::;	1241	our @ISA = CFClient::UI::Base::;
1136		1242
1137	sub new {	1243	sub new {
1138	my $class = shift;	1244	my $class = shift;
1139		1245
1140	$class->SUPER::new (	1246	$class->SUPER::new (
…		…
1160		1266
1161	sub update {	1267	sub update {
1162	my ($self) = @_;	1268	my ($self) = @_;
1163		1269
1164	$self->{need_update} = 1;	1270	$self->{need_update} = 1;
		1271	$self->SUPER::update;
1165	}	1272	}
1166		1273
1167	sub _draw {	1274	sub _draw {
1168	my ($self) = @_;	1275	my ($self) = @_;
1169		1276
…		…
1192	$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};
1193	}	1300	}
1194		1301
1195	glEnable GL_TEXTURE_2D;	1302	glEnable GL_TEXTURE_2D;
1196	glEnable GL_BLEND;	1303	glEnable GL_BLEND;
		1304	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1197	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1305	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1198		1306
1199	my $sw4 = ($sw + 3) & ~3;	1307	my $sw4 = ($sw + 3) & ~3;
1200	my $darkness = "\x00" x ($sw4 * $sh);	1308	my $darkness = "\x00" x ($sw4 * $sh);
1201		1309
…		…
1231	#	1339	#
1232	# $lighting = $pb->get_pixels;	1340	# $lighting = $pb->get_pixels;
1233	# $lighting =~ s/(.)../$1/gs;	1341	# $lighting =~ s/(.)../$1/gs;
1234	# }	1342	# }
1235		1343
1236	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1237	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1344	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1238		1345
1239	$darkness = new CFClient::Texture	1346	$darkness = new CFClient::Texture
1240	width => $sw4,	1347	w => $sw4,
1241	height => $sh,	1348	h => $sh,
1242	data => $darkness,	1349	data => $darkness,
1243	internalformat => GL_ALPHA,	1350	internalformat => GL_ALPHA,
1244	format => GL_ALPHA;	1351	format => GL_ALPHA;
1245		1352
1246	glColor 0.45, 0.45, 0.45, 1;	1353	glColor 0.45, 0.45, 0.45, 1;
…		…
1306	}	1413	}
1307	}	1414	}
1308		1415
1309	#############################################################################	1416	#############################################################################
1310		1417
1311	package CFClient::Widget::Animator;	1418	package CFClient::UI::Animator;
1312		1419
1313	use SDL::OpenGL;	1420	use SDL::OpenGL;
1314		1421
1315	our @ISA = CFClient::Widget::Bin::;	1422	our @ISA = CFClient::UI::Bin::;
1316		1423
1317	sub moveto {	1424	sub moveto {
1318	my ($self, $x, $y) = @_;	1425	my ($self, $x, $y) = @_;
1319		1426
1320	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	1427	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
1348	glPopMatrix;	1455	glPopMatrix;
1349	}	1456	}
1350		1457
1351	#############################################################################	1458	#############################################################################
1352		1459
1353	package CFClient::Widget::Toplevel;	1460	package CFClient::UI::Toplevel;
1354		1461
1355	our @ISA = CFClient::Widget::Container::;	1462	our @ISA = CFClient::UI::Container::;
1356		1463
1357	sub size_request {	1464	sub size_request {
1358	($::WIDTH, $::HEIGHT)	1465	($::WIDTH, $::HEIGHT)
1359	}	1466	}
1360		1467
1361	sub size_allocate {	1468	sub size_allocate {
1362	my ($self, $w, $h) = @_;	1469	my ($self, $x, $y, $w, $h) = @_;
1363		1470
1364	$self->SUPER::size_allocate ($w, $h);	1471	$self->_size_allocate ($x, $y, $w, $h);
1365		1472
1366	$_->size_allocate ($_->size_request)	1473	$_->size_allocate ($_->{x}, $_->{y}, $_->size_request)
1367	for @{$self->{children}};	1474	for @{$self->{children}};
1368	}	1475	}
1369		1476
1370	sub translate {	1477	sub translate {
1371	my ($self, $x, $y) = @_;	1478	my ($self, $x, $y) = @_;
…		…
1374	}	1481	}
1375		1482
1376	sub update {	1483	sub update {
1377	my ($self) = @_;	1484	my ($self) = @_;
1378		1485
1379	$self->size_allocate ($self->size_request);	1486	$self->size_allocate (0, 0, $::WIDTH, $::HEIGHT);
1380	::refresh ();	1487	::refresh ();
1381	}	1488	}
1382		1489
1383	sub add {	1490	sub add {
1384	my ($self, $widget) = @_;	1491	my ($self, $widget) = @_;
1385		1492
1386	$self->SUPER::add ($widget);	1493	$self->SUPER::add ($widget);
1387		1494
1388	$widget->size_allocate ($widget->size_request);	1495	$widget->size_allocate ($widget->{x}, $widget->{y}, $widget->size_request);
1389	}	1496	}
1390		1497
1391	sub draw {	1498	sub draw {
1392	my ($self) = @_;	1499	my ($self) = @_;
1393		1500
1394	$self->_draw;	1501	$self->_draw;
1395	}	1502	}
1396		1503
1397	#############################################################################	1504	#############################################################################
1398		1505
1399	package CFClient::Widget;	1506	package CFClient::UI;
1400		1507
1401	$TOPLEVEL = new CFClient::Widget::Toplevel;	1508	$TOPLEVEL = new CFClient::UI::Toplevel;
1402		1509
1403	1	1510	1
1404		1511

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.72 by root, Tue Apr 11 18:00:45 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.72 by root, Tue Apr 11 18:00:45 2006 UTC vs.
Revision 1.76 by root, Tue Apr 11 21:24:09 2006 UTC