deliantra/Deliantra-Client/DC.pm

=head1 NAME

Crossfire::Client - undocumented utility garbage for our crossfire client

=head1 SYNOPSIS

 use Crossfire::Client;

=head1 DESCRIPTION

=over 4

=cut

package Crossfire::Client;

BEGIN {
   $VERSION = '0.1';

   use XSLoader;
   XSLoader::load "Crossfire::Client", $VERSION;
}

package Crossfire::Client::Texture;

use Scalar::Util;

use SDL::OpenGL;

my @textures;

sub _new {
   my ($class, %data) = @_;

   my $self = bless \%data, $class;

   push @textures, $self;
   Scalar::Util::weaken $textures[-1];

   $self->upload;

   $self
}

sub new_from_image {
   my ($class, $image) = @_;

   $class->_new (image => $image)
}

sub new_from_file {
   my ($class, $path) = @_;

   open my $fh, "<:raw", $path
      or die "$path: $!";

   local $/;
   $class->new_from_image (<$fh>)
}

sub new_from_surface {
   my ($class, $surface) = @_;

   $surface->rgba;

   $class->_new (
      data   => $surface->pixels,
      width  => $surface->width,
      height => $surface->height,
   )
}

sub upload {
   my ($self) = @_;

   return unless $SDL::App::USING_OPENGL;

   my ($data, $width, $height);

   if (exists $self->{data}) {
      ($data, $width, $height) = ($self->{data}, $self->{width}, $self->{height});
   } else {
      my $pb = new Gtk2::Gdk::PixbufLoader;
      $pb->write ($self->{image});
      $pb->close;

      $pb = $pb->get_pixbuf;
      $pb = $pb->add_alpha (0, 0, 0, 0);

      ($data, $width, $height) = ($pb->get_pixels, $pb->get_width, $pb->get_height);
   }

   ($self->{name}) = @{glGenTextures 1};

   glBindTexture GL_TEXTURE_2D, $self->{name};

   glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
   glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;#_MIPMAP_LINEAR;
   glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP;
   glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP;
   
   glTexImage2D GL_TEXTURE_2D, 0,
                GL_RGBA8,
                $width, $height,
                0,
                GL_RGBA,
                GL_UNSIGNED_BYTE,
                $data;
}

sub DESTROY {
   my ($self) = @_;

   return unless exists $self->{name};

   glDeleteTextures delete $self->{name};
}

push @::GLINIT, sub {
   $_->upload
      for grep $_, @textures;
};

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.4
Committed:	Fri Apr 7 18:49:52 2006 UTC (18 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.3:	+29 -13 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Crossfire::Client - undocumented utility garbage for our crossfire client
4
5			=head1 SYNOPSIS
6
7			use Crossfire::Client;
8
9			=head1 DESCRIPTION
10
11			=over 4
12
13			=cut
14
15			package Crossfire::Client;
16
17			BEGIN {
18			$VERSION = '0.1';
19
20	root	1.2	use XSLoader;
21	root	1.1	XSLoader::load "Crossfire::Client", $VERSION;
22			}
23
24	root	1.3	package Crossfire::Client::Texture;
25
26			use Scalar::Util;
27
28			use SDL::OpenGL;
29
30			my @textures;
31
32	root	1.4	sub _new {
33			my ($class, %data) = @_;
34
35			my $self = bless \%data, $class;
36
37			push @textures, $self;
38			Scalar::Util::weaken $textures[-1];
39
40			$self->upload;
41
42			$self
43			}
44
45			sub new_from_image {
46			my ($class, $image) = @_;
47
48			$class->_new (image => $image)
49			}
50
51	root	1.3	sub new_from_file {
52			my ($class, $path) = @_;
53
54			open my $fh, "<:raw", $path
55			or die "$path: $!";
56
57			local $/;
58	root	1.4	$class->new_from_image (<$fh>)
59	root	1.3	}
60
61	root	1.4	sub new_from_surface {
62			my ($class, $surface) = @_;
63	root	1.3
64	root	1.4	$surface->rgba;
65	root	1.3
66	root	1.4	$class->_new (
67			data => $surface->pixels,
68			width => $surface->width,
69			height => $surface->height,
70			)
71	root	1.3	}
72
73			sub upload {
74			my ($self) = @_;
75
76			return unless $SDL::App::USING_OPENGL;
77
78			my ($data, $width, $height);
79
80			if (exists $self->{data}) {
81			($data, $width, $height) = ($self->{data}, $self->{width}, $self->{height});
82			} else {
83			my $pb = new Gtk2::Gdk::PixbufLoader;
84	root	1.4	$pb->write ($self->{image});
85	root	1.3	$pb->close;
86
87			$pb = $pb->get_pixbuf;
88			$pb = $pb->add_alpha (0, 0, 0, 0);
89
90			($data, $width, $height) = ($pb->get_pixels, $pb->get_width, $pb->get_height);
91			}
92
93			($self->{name}) = @{glGenTextures 1};
94
95			glBindTexture GL_TEXTURE_2D, $self->{name};
96
97			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
98			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;#_MIPMAP_LINEAR;
99			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP;
100			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP;
101
102			glTexImage2D GL_TEXTURE_2D, 0,
103			GL_RGBA8,
104			$width, $height,
105			0,
106			GL_RGBA,
107			GL_UNSIGNED_BYTE,
108			$data;
109			}
110
111			sub DESTROY {
112			my ($self) = @_;
113
114			return unless exists $self->{name};
115
116			glDeleteTextures delete $self->{name};
117			}
118
119			push @::GLINIT, sub {
120			$_->upload
121			for grep $_, @textures;
122			};
123
124	root	1.1	1;
125
126			=back
127
128			=head1 AUTHOR
129
130			Marc Lehmann <schmorp@schmorp.de>
131			http://home.schmorp.de/
132
133			=cut
134