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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.75 by root, Tue Apr 11 20:44:49 2006 UTC vs.
Revision 1.89 by root, Wed Apr 12 21:20:42 2006 UTC

…		…
43		43
44	my $widget = $GRAB \|\| $TOPLEVEL->find_widget ($x, $y);	44	my $widget = $GRAB \|\| $TOPLEVEL->find_widget ($x, $y);
45		45
46	$BUTTON_STATE &= ~(1 << ($ev->button - 1));	46	$BUTTON_STATE &= ~(1 << ($ev->button - 1));
47		47
48	$GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB;	48	$GRAB->button_up ($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;
…		…
79	use SDL::OpenGL;	79	use SDL::OpenGL;
80		80
81	sub new {	81	sub new {
82	my $class = shift;	82	my $class = shift;
83		83
84	bless {	84	my $self = bless {
85	x => 0,	85	x => 0,
86	y => 0,	86	y => 0,
87	z => 0,	87	z => 0,
88	w => -1,	88	w => -1,
89	h => -1,	89	h => -1,
90	@_	90	@_
91	}, $class	91	}, $class;
		92
		93	for (keys %$self) {
		94	if (/^connect_(.*)$/) {
		95	$self->connect ($1 => delete $self->{$_});
		96	}
		97	}
		98
		99	$self
92	}	100	}
93		101
94	sub move {	102	sub move {
95	my ($self, $x, $y, $z) = @_;	103	my ($self, $x, $y, $z) = @_;
96	$self->{x} = $x;	104	$self->{x} = $x;
…		…
125	my ($self, $x, $y, $w, $h) = @_;	133	my ($self, $x, $y, $w, $h) = @_;
126		134
127	$self->_size_allocate ($x, $y, $w, $h);	135	$self->_size_allocate ($x, $y, $w, $h);
128	}	136	}
129		137
130	# translate global koordinates to local coordinate system	138	# translate global coordinates to local coordinate system
131	sub translate {	139	sub translate {
132	my ($self, $x, $y) = @_;	140	my ($self, $x, $y) = @_;
133		141
134	$self->{parent}->translate ($x - $self->{x}, $y - $self->{y});	142	$self->{parent}->translate ($x - $self->{x}, $y - $self->{y});
135	}	143	}
…		…
181	glPopMatrix;	189	glPopMatrix;
182		190
183	if ($self == $HOVER) {	191	if ($self == $HOVER) {
184	my ($x, $y) = @$self{qw(x y)};	192	my ($x, $y) = @$self{qw(x y)};
185		193
186	glColor 1, 1, 1, 0.1;	194	glColor 0, 0, 1, 0.2;
187	glEnable GL_BLEND;	195	glEnable GL_BLEND;
188	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	196	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
189	glBegin GL_QUADS;	197	glBegin GL_QUADS;
190	glVertex $x , $y;	198	glVertex $x , $y;
191	glVertex $x + $self->{w}, $y;	199	glVertex $x + $self->{w}, $y;
…		…
200	my ($self) = @_;	208	my ($self) = @_;
201		209
202	warn "no draw defined for $self\n";	210	warn "no draw defined for $self\n";
203	}	211	}
204		212
205	sub bbox {
206	my ($self) = @_;
207	my ($w, $h) = $self->size_request;
208	(
209	$self->{x},
210	$self->{y},
211	$self->{x} = $w,
212	$self->{y} = $h
213	)
214	}
215
216	sub find_widget {	213	sub find_widget {
217	my ($self, $x, $y) = @_;	214	my ($self, $x, $y) = @_;
218		215
219	return $self	216	return $self
220	if $x >= $self->{x} && $x < $self->{x} + $self->{w}	217	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
221	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};	218	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
222		219
223	()	220	()
224	}	221	}
225		222
226	sub del_parent { $_[0]->{parent} = undef }
227
228	sub set_parent {	223	sub set_parent {
229	my ($self, $par) = @_;	224	my ($self, $par) = @_;
230		225
231	$self->{parent} = $par;	226	$self->{parent} = $par;
232	Scalar::Util::weaken $self->{parent};	227	Scalar::Util::weaken $self->{parent};
…		…
275	my $class = shift;	270	my $class = shift;
276		271
277	# range [value, low, high, page]	272	# range [value, low, high, page]
278		273
279	$class->SUPER::new (	274	$class->SUPER::new (
280	bg => [0, 0, 0, 0.4],	275	bg => [0, 0, 0, 0.2],
281	active_bg => [1, 1, 1],	276	active_bg => [1, 1, 1, 0.5],
282	@_	277	@_
283	)	278	)
284	}	279	}
285		280
286	sub _draw {	281	sub _draw {
287	my ($self) = @_;	282	my ($self) = @_;
288		283
289	my ($w, $h) = @$self{qw(w h)};	284	my ($w, $h) = @$self{qw(w h)};
290		285
		286	glEnable GL_BLEND;
		287	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
291	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };	288	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };
		289
292	glBegin GL_QUADS;	290	glBegin GL_QUADS;
293	glVertex 0 , 0;	291	glVertex 0 , 0;
294	glVertex 0 , $h;	292	glVertex 0 , $h;
295	glVertex $w, $h;	293	glVertex $w, $h;
296	glVertex $w, 0;	294	glVertex $w, 0;
297	glEnd;	295	glEnd;
		296
		297	glDisable GL_BLEND;
298	}	298	}
299		299
300	#############################################################################	300	#############################################################################
301		301
302	package CFClient::UI::Empty;	302	package CFClient::UI::Empty;
…		…
325		325
326	$self	326	$self
327	}	327	}
328		328
329	sub add {	329	sub add {
330	my ($self, $chld, $expand) = @_;	330	my ($self, $chld) = @_;
331		331
332	$chld->{expand} = $expand;
333	$chld->set_parent ($self);	332	$chld->set_parent ($self);
334		333
335	$self->{children} = [	334	$self->{children} = [
336	sort { $a->{z} <=> $b->{z} }	335	sort { $a->{z} <=> $b->{z} }
337	@{$self->{children}}, $chld	336	@{$self->{children}}, $chld
…		…
533	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	532	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
534		533
535	sub size_request {	534	sub size_request {
536	my ($self) = @_;	535	my ($self) = @_;
537		536
		537	return ($self->{user_w}, $self->{user_h}) if $self->{user_w} && $self->{user_h};
		538
538	my ($w, $h) = $self->SUPER::size_request;	539	my ($w, $h) = $self->SUPER::size_request;
539		540
540	$h += $tex[1]->{h};	541	$h += $tex[1]->{h};
541	$h += $tex[4]->{h};	542	$h += $tex[4]->{h};
542	$w += $tex[2]->{w};	543	$w += $tex[2]->{w};
…		…
548	sub size_allocate {	549	sub size_allocate {
549	my ($self, $x, $y, $w, $h) = @_;	550	my ($self, $x, $y, $w, $h) = @_;
550		551
551	$self->_size_allocate ($x, $y, $w, $h) or return;	552	$self->_size_allocate ($x, $y, $w, $h) or return;
552		553
553	$h -= $tex[1]->{h};	554	$h -= $tex[1]{h};
554	$h -= $tex[4]->{h};	555	$h -= $tex[4]{h};
555	$w -= $tex[2]->{w};	556	$w -= $tex[2]{w};
556	$w -= $tex[3]->{w};	557	$w -= $tex[3]{w};
557		558
558	$h = $h < 0 ? 0 : $h;	559	$h = $h < 0 ? 0 : $h;
559	$w = $w < 0 ? 0 : $w;	560	$w = $w < 0 ? 0 : $w;
560		561
561	my $child = $self->child;	562	my $child = $self->child;
562		563
563	$child->size_allocate ($tex[3]->{w}, $tex[1]->{h}, $w, $h);	564	$child->size_allocate ($tex[3]->{w}, $tex[1]->{h}, $w, $h);
		565	}
		566
		567	sub button_down {
		568	my ($self, $ev, $x, $y) = @_;
		569
		570	if ($x < $self->{w} && $x >= $self->{w} - $tex[2]{w}
		571	&& $y < $self->{h} && $y >= $self->{h} - $tex[4]{h}) {
		572
		573	my ($ox, $oy) = ($ev->button_x, $ev->button_y);
		574	my ($bw, $bh) = ($self->{w}, $self->{h});
		575
		576	$self->{motion} = sub {
		577	my ($ev, $x, $y) = @_;
		578
		579	($x, $y) = ($ev->motion_x, $ev->motion_y);
		580
		581	$self->{user_w} = $bw + $x - $ox;
		582	$self->{user_h} = $bh + $y - $oy;
		583	$self->update;
		584	};
		585
		586	} elsif ($x >= 0 && $x < $self->{w}
		587	&& $y >= 0 && $y < $tex[1]{h}) {
		588
		589	my ($ox, $oy) = ($ev->button_x, $ev->button_y);
		590	my ($bx, $by) = ($self->{x}, $self->{y});
		591
		592	$self->{motion} = sub {
		593	my ($ev, $x, $y) = @_;
		594
		595	($x, $y) = ($ev->motion_x, $ev->motion_y);
		596
		597	$self->move ($bx + $x - $ox, $by + $y - $oy);
		598	$self->update;
		599	};
		600	}
		601	}
		602
		603	sub button_up {
		604	my ($self, $ev, $x, $y) = @_;
		605
		606	delete $self->{motion};
		607	}
		608
		609	sub mouse_motion {
		610	my ($self, $ev, $x, $y) = @_;
		611
		612	$self->{motion}->($ev, $x, $y) if $self->{motion};
564	}	613	}
565		614
566	sub _draw {	615	sub _draw {
567	my ($self) = @_;	616	my ($self) = @_;
568		617
…		…
585		634
586	my $bottom = $tex[4];	635	my $bottom = $tex[4];
587	$bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h});	636	$bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h});
588		637
589	my $bg = $tex[0];	638	my $bg = $tex[0];
		639
590	glBindTexture GL_TEXTURE_2D, $bg->{name};	640	glBindTexture GL_TEXTURE_2D, $bg->{name};
591	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	641	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
592	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
593	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
594		642
595	my $rep_x = $cw / $bg->{w};	643	my $rep_x = $cw / $bg->{w};
596	my $rep_y = $ch / $bg->{h};	644	my $rep_y = $ch / $bg->{h};
597		645
598	$bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch);	646	$bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch);
599		647
		648	glDisable GL_TEXTURE_2D;
600	glDisable GL_BLEND;	649	glDisable GL_BLEND;
601	glDisable GL_TEXTURE_2D;
602		650
603	$self->child->draw;	651	$self->child->draw;
604		652
605	}	653	}
606		654
…		…
611	our @ISA = CFClient::UI::Base::;	659	our @ISA = CFClient::UI::Base::;
612		660
613	use List::Util qw(max sum);	661	use List::Util qw(max sum);
614		662
615	use SDL::OpenGL;	663	use SDL::OpenGL;
		664
		665	sub new {
		666	my $class = shift;
		667
		668	$class->SUPER::new (
		669	col_expand => [],
		670	@_
		671	)
		672	}
616		673
617	sub add {	674	sub add {
618	my ($self, $x, $y, $chld) = @_;	675	my ($self, $x, $y, $chld) = @_;
619		676
620	$self->{children}[$y][$x] = $chld;	677	$self->{children}[$y][$x] = $chld;
…		…
650	my ($self) = @_;	707	my ($self) = @_;
651		708
652	my ($ws, $hs) = $self->get_wh;	709	my ($ws, $hs) = $self->get_wh;
653		710
654	(	711	(
655	(List::Util::sum @$ws),	712	(sum @$ws),
656	(List::Util::sum @$hs),	713	(sum @$hs),
657	)	714	)
658	}	715	}
659		716
660	sub size_allocate {	717	sub size_allocate {
661	my ($self, $x, $y, $w, $h) = @_;	718	my ($self, $x, $y, $w, $h) = @_;
662		719
663	$self->_size_allocate ($x, $y, $w, $h) or return;	720	$self->_size_allocate ($x, $y, $w, $h) or return;
664		721
665	my ($ws, $hs) = $self->get_wh;	722	my ($ws, $hs) = $self->get_wh;
666		723
667	my $req_w = List::Util::sum @$ws;	724	my $req_w = sum @$ws;
668	my $req_h = List::Util::sum @$hs;	725	my $req_h = sum @$hs;
		726
		727	# TODO: nicer code && do row_expand
		728	my @col_expand = @{$self->{col_expand}};
		729	@col_expand = (1) x @$ws unless @col_expand;
		730	my $col_expand = (sum @col_expand) \|\| 1;
669		731
670	# linearly scale sizes	732	# linearly scale sizes
671	$_ *= $req_w / $w for @$ws;	733	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
672	$_ *= $req_h / $h for @$hs;	734	$hs->[$_] = 1 $h / $req_h for 0 .. $#$hs;
673		735
674	my $y;	736	my $y;
675		737
676	for my $r (0 .. $#{$self->{children}}) {	738	for my $r (0 .. $#{$self->{children}}) {
677	my $row = $self->{children}[$r]	739	my $row = $self->{children}[$r]
…		…
679		741
680	my $x = 0;	742	my $x = 0;
681	my $row_h = $hs->[$r];	743	my $row_h = $hs->[$r];
682		744
683	for my $c (0 .. $#$row) {	745	for my $c (0 .. $#$row) {
684	my $widget = $row->[$c]
685	or next;
686
687	my $col_w = $ws->[$c];	746	my $col_w = $ws->[$c];
688		747
		748	if (my $widget = $row->[$c]) {
689	$widget->size_allocate ($x, $y, $col_w, $row_h);	749	$widget->size_allocate ($x, $y, $col_w, $row_h);
		750	}
690		751
691	$x += $col_w;	752	$x += $col_w;
692	}	753	}
693		754
694	$y += $row_h;	755	$y += $row_h;
695	}	756	}
696		757
697	}	758	}
698		759
		760	sub find_widget {
		761	my ($self, $x, $y) = @_;
		762
		763	$x -= $self->{x};
		764	$y -= $self->{y};
		765
		766	my $res;
		767
		768	for (grep $_, map @$_, grep $_, @{ $self->{children} }) {
		769	$res = $_->find_widget ($x, $y)
		770	and return $res;
		771	}
		772
		773	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
		774	}
		775
699	sub _draw {	776	sub _draw {
700	my ($self) = @_;	777	my ($self) = @_;
701		778
702	for (grep $_, @{$self->{children}}) {	779	for (grep $_, @{$self->{children}}) {
703	$_->draw for grep $_, @$_;	780	$_->draw for grep $_, @$_;
704	}	781	}
705	}	782	}
706		783
707	#############################################################################	784	#############################################################################
708		785
		786	package CFClient::UI::HBox;
		787
		788	# TODO: wrap into common Box base class
		789
		790	our @ISA = CFClient::UI::Container::;
		791
		792	sub size_request {
		793	my ($self) = @_;
		794
		795	my @alloc = map [$_->size_request], @{$self->{children}};
		796
		797	(
		798	(List::Util::sum map $_->[0], @alloc),
		799	(List::Util::max map $_->[1], @alloc),
		800	)
		801	}
		802
		803	sub size_allocate {
		804	my ($self, $x, $y, $w, $h) = @_;
		805
		806	$self->_size_allocate ($x, $y, $w, $h);
		807
		808	($h, $w) = ($w, $h);
		809
		810	my $children = $self->{children};
		811
		812	my @h = map +($_->size_request)[0], @$children;
		813
		814	my $req_h = List::Util::sum @h;
		815
		816	if ($req_h > $h) {
		817	# ah well, not enough space
		818	$_ *= $h / $req_h for @h;
		819	} else {
		820	my $exp = List::Util::sum map $_->{expand}, @$children;
		821	$exp \|\|= 1;
		822
		823	for (0 .. $#$children) {
		824	my $child = $children->[$_];
		825
		826	my $alloc_h = $h[$_];
		827	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
		828	$h[$_] = $alloc_h;
		829	}
		830	}
		831
		832	my $y = 0;
		833	for (0 .. $#$children) {
		834	my $child = $children->[$_];
		835	my $h = $h[$_];
		836	$child->size_allocate ($y, 0, $h, $w);
		837
		838	$y += $h;
		839	}
		840	}
		841
		842	#############################################################################
		843
709	package CFClient::UI::VBox;	844	package CFClient::UI::VBox;
710		845
		846	# TODO: wrap into common Box base class
		847
711	our @ISA = CFClient::UI::Container::;	848	our @ISA = CFClient::UI::Container::;
712
713	use SDL::OpenGL;
714		849
715	sub size_request {	850	sub size_request {
716	my ($self) = @_;	851	my ($self) = @_;
717		852
718	my @alloc = map [$_->size_request], @{$self->{children}};	853	my @alloc = map [$_->size_request], @{$self->{children}};
…		…
724	}	859	}
725		860
726	sub size_allocate {	861	sub size_allocate {
727	my ($self, $x, $y, $w, $h) = @_;	862	my ($self, $x, $y, $w, $h) = @_;
728		863
729	$self->_size_allocate ($x, $y, $w, $h) or return;	864	$self->_size_allocate ($x, $y, $w, $h);
730
731	return unless $self->{h};
732		865
733	my $children = $self->{children};	866	my $children = $self->{children};
734		867
735	my @h = map +($_->size_request)[1], @$children;	868	my @h = map +($_->size_request)[1], @$children;
736		869
737	my $req_h = List::Util::sum @h;	870	my $req_h = List::Util::sum @h;
738		871
739	if ($req_h > $h) {	872	if ($req_h > $h) {
740	# ah well, not enough space	873	# ah well, not enough space
741	$_ = $h[$_] * $h / $req_h for @h;	874	$_ *= $h / $req_h for @h;
742	} else {	875	} else {
743	my @exp = grep $_->{expand}, @$children;	876	my $exp = List::Util::sum map $_->{expand}, @$children;
744	@exp = @$children unless @exp;	877	$exp \|\|= 1;
745		878
746	my %exp = map +($_ => 1), @exp;
747
748	for (0 .. $#$children) {	879	for (0 .. $#$children) {
749	my $child = $children->[$_];	880	my $child = $children->[$_];
750		881
751	my $alloc_h = $h[$_];	882	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
752	$alloc_h += ($h - $req_h) / @exp if $exp{$child};
753	$h[$_] = $alloc_h;
754	}	883	}
755	}	884	}
756		885
757	my $y = 0;	886	my $y = 0;
758	for (0 .. $#$children) {	887	for (0 .. $#$children) {
…		…
774		903
775	sub new {	904	sub new {
776	my ($class, %arg) = @_;	905	my ($class, %arg) = @_;
777		906
778	my $self = $class->SUPER::new (	907	my $self = $class->SUPER::new (
779	fg => [1, 1, 1],	908	fg => [1, 1, 1],
780	height => $::FONTSIZE,	909	height => $::FONTSIZE,
781	text => "",	910	text => "",
782	align => -1,	911	align => -1,
		912	padding => 2,
783	layout => new CFClient::Layout,	913	layout => new CFClient::Layout,
784	%arg	914	%arg
785	);	915	);
786		916
787	$self->set_text ($self->{text});	917	$self->set_text ($self->{text});
788		918
…		…
804		934
805	$self->{text} = $text;	935	$self->{text} = $text;
806	$self->{layout}->set_markup ($text);	936	$self->{layout}->set_markup ($text);
807		937
808	delete $self->{texture};	938	delete $self->{texture};
		939	# $self->{w} = $self->{h} = -1;
809	$self->update;	940	$self->update;
810	}	941	}
811		942
812	sub get_text {	943	sub get_text {
813	my ($self, $text) = @_;	944	my ($self, $text) = @_;
…		…
818	sub size_request {	949	sub size_request {
819	my ($self) = @_;	950	my ($self) = @_;
820		951
821	$self->{layout}->set_width;	952	$self->{layout}->set_width;
822	$self->{layout}->set_height ($self->{height});	953	$self->{layout}->set_height ($self->{height});
823	$self->{layout}->size	954	my ($w, $h) = $self->{layout}->size;
824	# if ($self->{texture}{w} > 1 && $self->{texture}{height} > 1) { #TODO: hack	955
825	# (	956	(
826	# $self->{texture}{w},	957	$w + $self->{padding} * 2,
827	# $self->{texture}{h},	958	$h + $self->{padding} * 2,
828	# )	959	)
829	# } else {
830	# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{h};
831	#
832	# ($w, $h)
833	# }
834	}	960	}
835		961
836	sub size_allocate {	962	sub size_allocate {
837	my ($self, $x, $y, $w, $h) = @_;	963	my ($self, $x, $y, $w, $h) = @_;
838		964
…		…
851	sub _draw {	977	sub _draw {
852	my ($self) = @_;	978	my ($self) = @_;
853		979
854	my $tex = $self->{texture} \|\|= do {	980	my $tex = $self->{texture} \|\|= do {
855	$self->{layout}->set_width ($self->{w});	981	$self->{layout}->set_width ($self->{w});
		982	$self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height});
856	new_from_layout CFClient::Texture $self->{layout}	983	new_from_layout CFClient::Texture $self->{layout}
857	};	984	};
858		985
859	glEnable GL_BLEND;	986	glEnable GL_BLEND;
860	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	987	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
…		…
862	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	989	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
863		990
864	glColor @{$self->{fg}};	991	glColor @{$self->{fg}};
865		992
866	my $x =	993	my $x =
867	$self->{align} < 0 ? 0	994	$self->{align} < 0 ? $self->{padding}
868	: $self->{align} > 0 ? $self->{w} - $tex->{w}	995	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
869	: ($self->{w} - $tex->{w}) * 0.5;	996	: ($self->{w} - $tex->{w}) * 0.5;
870		997
		998	glTranslate $x, ($self->{h} - $tex->{h}) * 0.5, 0;
871	$tex->draw_quad ($x, 0);	999	$tex->draw_quad (0, 0);
872		1000
873	glDisable GL_TEXTURE_2D;	1001	glDisable GL_TEXTURE_2D;
874	glDisable GL_BLEND;	1002	glDisable GL_BLEND;
875	}	1003	}
876		1004
…		…
886	sub new {	1014	sub new {
887	my $class = shift;	1015	my $class = shift;
888		1016
889	$class->SUPER::new (	1017	$class->SUPER::new (
890	fg => [1, 1, 1],	1018	fg => [1, 1, 1],
891	bg => [0, 0, 0, 0.4],	1019	bg => [0, 0, 0, 0.2],
892	active_bg => [1, 1, 1],	1020	active_bg => [1, 1, 1, 0.5],
893	active_fg => [0, 0, 0],	1021	active_fg => [0, 0, 0],
894	@_	1022	@_
895	)	1023	)
896	}	1024	}
897		1025
…		…
900		1028
901	$self->{last_activity} = $::NOW;	1029	$self->{last_activity} = $::NOW;
902		1030
903	$self->{text} = $text;	1031	$self->{text} = $text;
904	$self->{layout}->set_width ($self->{w});	1032	$self->{layout}->set_width ($self->{w});
		1033	$self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height});
905		1034
906	$text =~ s/./*/g if $self->{hidden};	1035	$text =~ s/./*/g if $self->{hidden};
907		1036
908
909	$self->{layout}->set_markup ($self->escape_text ($text));	1037	$self->{layout}->set_markup ($self->escape_text ($text) . " ");
910		1038
911	$text = substr $text, 0, $self->{cursor};	1039	$text = substr $text, 0, $self->{cursor};
912	utf8::encode $text;	1040	utf8::encode $text;
913		1041
914	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);	1042	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
…		…
954	substr $text, $self->{cursor}, 1, "";	1082	substr $text, $self->{cursor}, 1, "";
955	} elsif ($sym == SDLK_LEFT) {	1083	} elsif ($sym == SDLK_LEFT) {
956	--$self->{cursor} if $self->{cursor};	1084	--$self->{cursor} if $self->{cursor};
957	} elsif ($sym == SDLK_RIGHT) {	1085	} elsif ($sym == SDLK_RIGHT) {
958	++$self->{cursor} if $self->{cursor} < length $self->{text};	1086	++$self->{cursor} if $self->{cursor} < length $self->{text};
		1087	} elsif ($sym == SDLK_HOME) {
		1088	$self->{cursor} = 0;
		1089	} elsif ($sym == SDLK_END) {
		1090	$self->{cursor} = length $text;
959	} elsif ($uni) {	1091	} elsif ($uni) {
960	substr $text, $self->{cursor}++, 0, chr $uni;	1092	substr $text, $self->{cursor}++, 0, chr $uni;
961	}	1093	}
962		1094
963	$self->_set_text ($text);	1095	$self->_set_text ($text);
…		…
978	$self->SUPER::button_down ($ev, $x, $y);	1110	$self->SUPER::button_down ($ev, $x, $y);
979		1111
980	my $idx = $self->{layout}->xy_to_index ($x, $y);	1112	my $idx = $self->{layout}->xy_to_index ($x, $y);
981		1113
982	# byte-index to char-index	1114	# byte-index to char-index
983	my $text = $self->{layout};	1115	my $text = $self->{text};
984	utf8::encode $text;	1116	utf8::encode $text;
985	$self->{cursor} = length substr $text, 0, $idx;	1117	$self->{cursor} = length substr $text, 0, $idx;
986		1118
987	$self->_set_text ($self->{text});	1119	$self->_set_text ($self->{text});
988	$self->update;	1120	$self->update;
…		…
1003	$self->{fg} = $self->{active_fg};	1135	$self->{fg} = $self->{active_fg};
1004	} else {	1136	} else {
1005	glColor @{$self->{bg}};	1137	glColor @{$self->{bg}};
1006	}	1138	}
1007		1139
		1140	glEnable GL_BLEND;
		1141	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1008	glBegin GL_QUADS;	1142	glBegin GL_QUADS;
1009	glVertex 0 , 0;	1143	glVertex 0 , 0;
1010	glVertex 0 , $self->{h};	1144	glVertex 0 , $self->{h};
1011	glVertex $self->{w}, $self->{h};	1145	glVertex $self->{w}, $self->{h};
1012	glVertex $self->{w}, 0;	1146	glVertex $self->{w}, 0;
1013	glEnd;	1147	glEnd;
		1148	glDisable GL_BLEND;
1014		1149
1015	$self->SUPER::_draw;	1150	$self->SUPER::_draw;
1016		1151
1017	#TODO: force update every cursor change :(	1152	#TODO: force update every cursor change :(
1018	if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {	1153	if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
…		…
1024	}	1159	}
1025	}	1160	}
1026		1161
1027	#############################################################################	1162	#############################################################################
1028		1163
1029	package CFClient::UI::Slider;	1164	package CFClient::UI::Button;
1030		1165
1031	use strict;	1166	our @ISA = CFClient::UI::Label::;
1032		1167
		1168	use SDL;
1033	use SDL::OpenGL;	1169	use SDL::OpenGL;
1034		1170
1035	our @ISA = CFClient::UI::DrawBG::;	1171	my @tex =
1036		1172	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
1037	sub size_request {	1173	qw(b1_button_active.png);
1038	my ($self) = @_;
1039
1040	my $w = 50;
1041	my $h = 10;
1042
1043	$self->{vertical} ? ($h, $w) : ($w, $h)
1044	}
1045		1174
1046	sub new {	1175	sub new {
1047	my $class = shift;	1176	my $class = shift;
1048		1177
		1178	$class->SUPER::new (
		1179	padding => 4,
		1180	fg => [1, 1, 1],
		1181	bg => [1, 1, 1, 0.2],
		1182	active_fg => [1, 1, 0],
		1183	# active_bg => [0, 0, 0, 0.5],
		1184	# border_fg => [1, 1, 0],
		1185	@_
		1186	)
		1187	}
		1188
		1189	sub button_up {
		1190	my ($self, $ev, $x, $y) = @_;
		1191
		1192	if ($x >= 0 && $x < $self->{w}
		1193	&& $y >= 0 && $y < $self->{h}) {
		1194	$self->emit ("activate");
		1195	}
		1196	}
		1197
		1198	sub _draw {
		1199	my ($self) = @_;
		1200
		1201	local $self->{fg} = $self->{fg};
		1202	my $tex = $tex[0];
		1203
		1204	glEnable GL_BLEND;
		1205	glEnable GL_TEXTURE_2D;
		1206	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
		1207
		1208	if ($GRAB == $self) {
		1209	$self->{fg} = $self->{active_fg};
		1210	}
		1211
		1212	glBindTexture GL_TEXTURE_2D, $tex->{name};
		1213	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		1214
		1215	$tex->draw_quad (0, 0, $self->{w}, $self->{h});
		1216
		1217	glDisable GL_TEXTURE_2D;
		1218	glDisable GL_BLEND;
		1219
		1220	$self->SUPER::_draw;
		1221	}
		1222
		1223	#############################################################################
		1224
		1225	package CFClient::UI::CheckBox;
		1226
		1227	our @ISA = CFClient::UI::DrawBG::;
		1228
		1229	use SDL;
		1230	use SDL::OpenGL;
		1231
		1232	sub new {
		1233	my $class = shift;
		1234
		1235	$class->SUPER::new (
		1236	padding => 2,
		1237	fg => [1, 1, 1],
		1238	active_fg => [1, 1, 0],
		1239	state => 0,
		1240	@_
		1241	)
		1242	}
		1243
		1244	sub size_request {
		1245	my ($self) = @_;
		1246
		1247	($self->{padding} * 2 + 6) x 2
		1248	}
		1249
		1250	sub size_allocate {
		1251	my ($self, $x, $y, $w, $h) = @_;
		1252
		1253	$self->_size_allocate ($x, $y, $w, $h);
		1254	}
		1255
		1256	sub button_down {
		1257	my ($self, $ev, $x, $y) = @_;
		1258
		1259	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}
		1260	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {
		1261	$self->{state} = !$self->{state};
		1262	$self->emit (changed => $self->{state});
		1263	}
		1264	}
		1265
		1266	sub _draw {
		1267	my ($self) = @_;
		1268
		1269	$self->SUPER::_draw;
		1270
		1271	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;
		1272
		1273	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;
		1274
		1275	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
		1276
		1277	glBegin GL_LINE_LOOP;
		1278	glVertex 0 , 0;
		1279	glVertex 0 , $s;
		1280	glVertex $s, $s;
		1281	glVertex $s, 0;
		1282	glEnd;
		1283
		1284	if ($self->{state}) {
		1285	glBegin GL_LINES;
		1286	glVertex 0 , 0;
		1287	glVertex $s, $s;
		1288	glVertex $s, 0;
		1289	glVertex 0 , $s;
		1290	glEnd;
		1291	}
		1292	}
		1293
		1294	#############################################################################
		1295
		1296	package CFClient::UI::Slider;
		1297
		1298	use strict;
		1299
		1300	use SDL::OpenGL;
		1301
		1302	our @ISA = CFClient::UI::DrawBG::;
		1303
		1304	sub new {
		1305	my $class = shift;
		1306
1049	# range [value, low, high, page]	1307	# range [value, low, high, page]
1050		1308
1051	$class->SUPER::new (	1309	my $self = $class->SUPER::new (
1052	fg => [1, 1, 1],	1310	fg => [1, 1, 1],
1053	active_fg => [0, 0, 0],	1311	active_fg => [0, 0, 0],
1054	range => [0, 0, 100, 10],	1312	range => [0, 0, 100, 10],
		1313	req_w => 40,
		1314	req_h => 10,
1055	vertical => 1,	1315	vertical => 0,
1056	@_	1316	@_
1057	)	1317	);
		1318
		1319	$self
		1320	}
		1321
		1322	sub size_request {
		1323	my ($self) = @_;
		1324
		1325	my $w = $self->{req_w};
		1326	my $h = $self->{req_h};
		1327
		1328	$self->{vertical} ? ($h, $w) : ($w, $h)
1058	}	1329	}
1059		1330
1060	sub button_down {	1331	sub button_down {
1061	my ($self, $ev, $x, $y) = @_;	1332	my ($self, $ev, $x, $y) = @_;
1062		1333
…		…
1107	$value = int +($value - $lo) * $w / ($hi - $lo);	1378	$value = int +($value - $lo) * $w / ($hi - $lo);
1108		1379
1109	$w -= $page;	1380	$w -= $page;
1110	$page &= ~1;	1381	$page &= ~1;
1111	glTranslate $page * 0.5, 0, 0;	1382	glTranslate $page * 0.5, 0, 0;
		1383	$page \|\|= 2;
1112		1384
1113	glColor @$fg;	1385	glColor @$fg;
1114	glBegin GL_LINES;	1386	glBegin GL_LINES;
1115	glVertex 0, 0; glVertex 0, $h;	1387	glVertex 0, 0; glVertex 0, $h;
1116	glVertex $w - 1, 0; glVertex $w - 1, $h;	1388	glVertex $w - 1, 0; glVertex $w - 1, $h;
…		…
1167	sub key_up {	1439	sub key_up {
1168	}	1440	}
1169		1441
1170	sub size_request {	1442	sub size_request {
1171	(	1443	(
1172	1 + int $::WIDTH / 32,	1444	1 + 32 * int $::WIDTH / 32,
1173	1 + int $::HEIGHT / 32,	1445	1 + 32 * int $::HEIGHT / 32,
1174	)	1446	)
1175	}	1447	}
1176		1448
1177	sub update {	1449	sub update {
1178	my ($self) = @_;	1450	my ($self) = @_;
1179		1451
1180	$self->{need_update} = 1;	1452	$self->{need_update} = 1;
1181	$self->SUPER::update;	1453	$self->SUPER::update;
1182	}	1454	}
1183		1455
1184	sub _draw {	1456	sub draw {
1185	my ($self) = @_;	1457	my ($self) = @_;
1186		1458
1187	if (delete $self->{need_update}) {	1459	if (delete $self->{need_update}) {
1188	glNewList $self->{list}, GL_COMPILE;	1460	glNewList $self->{list}, GL_COMPILE;
1189		1461
…		…
1211		1483
1212	glEnable GL_TEXTURE_2D;	1484	glEnable GL_TEXTURE_2D;
1213	glEnable GL_BLEND;	1485	glEnable GL_BLEND;
1214	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1486	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1215	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1487	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		1488	glColor 1, 1, 1, 1;
1216		1489
1217	my $sw4 = ($sw + 3) & ~3;	1490	my $sw4 = ($sw + 3) & ~3;
1218	my $darkness = "\x00" x ($sw4 * $sh);	1491	my $darkness = "\x00" x ($sw4 * $sh);
1219		1492
1220	for my $x (0 .. $sw - 1) {	1493	for my $x (0 .. $sw - 1) {
…		…
1268		1541
1269	glEndList;	1542	glEndList;
1270	}	1543	}
1271		1544
1272	glCallList $self->{list};	1545	glCallList $self->{list};
		1546
		1547	if ($FOCUS != $self) {
		1548	glEnable GL_BLEND;
		1549	glColor 0, 0, 1, 0.4;
		1550	glBegin GL_QUADS;
		1551	glVertex 0, 0;
		1552	glVertex 0, $::HEIGHT;
		1553	glVertex $::WIDTH, $::HEIGHT;
		1554	glVertex $::WIDTH, 0;
		1555	glEnd;
		1556	glDisable GL_BLEND;
		1557	}
1273	}	1558	}
1274		1559
1275	my %DIR = (	1560	my %DIR = (
1276	SDLK_KP8, [1, "north"],	1561	SDLK_KP8, [1, "north"],
1277	SDLK_KP9, [2, "northeast"],	1562	SDLK_KP9, [2, "northeast"],
…		…
1293		1578
1294	my $mod = $ev->key_mod;	1579	my $mod = $ev->key_mod;
1295	my $sym = $ev->key_sym;	1580	my $sym = $ev->key_sym;
1296		1581
1297	if ($sym == SDLK_KP5) {	1582	if ($sym == SDLK_KP5) {
1298	$::CONN->send ("command stay fire");	1583	$::CONN->user_send ("command stay fire");
		1584	} elsif ($sym == SDLK_a) {
		1585	$::CONN->user_send ("command apply");
1299	} elsif (exists $DIR{$sym}) {	1586	} elsif (exists $DIR{$sym}) {
1300	if ($mod & KMOD_SHIFT) {	1587	if ($mod & KMOD_SHIFT) {
1301	$self->{shft}++;	1588	$self->{shft}++;
1302	$::CONN->send ("command fire $DIR{$sym}[0]");	1589	$::CONN->user_send ("command fire $DIR{$sym}[0]");
1303	} elsif ($mod & KMOD_CTRL) {	1590	} elsif ($mod & KMOD_CTRL) {
1304	$self->{ctrl}++;	1591	$self->{ctrl}++;
1305	$::CONN->send ("command run $DIR{$sym}[0]");	1592	$::CONN->user_send ("command run $DIR{$sym}[0]");
1306	} else {	1593	} else {
1307	$::CONN->send ("command $DIR{$sym}[1]");	1594	$::CONN->user_send ("command $DIR{$sym}[1]");
1308	}	1595	}
1309	}	1596	}
1310	}	1597	}
1311		1598
1312	sub key_up {	1599	sub key_up {
…		…
1314		1601
1315	my $mod = $ev->key_mod;	1602	my $mod = $ev->key_mod;
1316	my $sym = $ev->key_sym;	1603	my $sym = $ev->key_sym;
1317		1604
1318	if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {	1605	if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
1319	$::CONN->send ("command fire_stop");	1606	$::CONN->user_send ("command fire_stop");
1320	}	1607	}
1321	if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {	1608	if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
1322	$::CONN->send ("command run_stop");	1609	$::CONN->user_send ("command run_stop");
1323	}	1610	}
1324	}	1611	}
1325		1612
1326	#############################################################################	1613	#############################################################################
1327		1614

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.75 by root, Tue Apr 11 20:44:49 2006 UTC vs. Revision 1.89 by root, Wed Apr 12 21:20:42 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.75 by root, Tue Apr 11 20:44:49 2006 UTC vs.
Revision 1.89 by root, Wed Apr 12 21:20:42 2006 UTC