=head1 NAME CFClient::Texture - tetxure class for CFClient =head1 SYNOPSIS use CFClient::Texture; =head1 DESCRIPTION =over 4 =cut package CFClient::Texture; use strict; use Scalar::Util; use CFClient::OpenGL; my %TEXTURES; sub new { my ($class, %data) = @_; my $self = bless { internalformat => GL_RGBA, format => GL_RGBA, type => GL_UNSIGNED_BYTE, %data, }, $class; Scalar::Util::weaken ($TEXTURES{$self+0} = $self); $self->upload; $self } sub new_from_image { my ($class, $image, %arg) = @_; $class->new (image => $image, %arg) } sub new_from_file { my ($class, $path, %arg) = @_; open my $fh, "<:raw", $path or die "$path: $!"; local $/; $class->new_from_image (<$fh>, %arg) } #sub new_from_surface { # my ($class, $surface) = @_; # # $surface->rgba; # # $class->new ( # data => $surface->pixels, # w => $surface->width, # h => $surface->height, # ) #} sub new_from_layout { my ($class, $layout, %arg) = @_; my ($w, $h, $data, $format, $internalformat) = $layout->render; $class->new ( w => $w, h => $h, data => $data, format => $format, internalformat => $format, type => GL_UNSIGNED_BYTE, %arg, ) } sub new_from_opengl { my ($class, $w, $h, $cb) = @_; $class->new (w => $w || 1, h => $h || 1, render_cb => $cb) } sub topot { (grep $_ >= $_[0], 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768)[0] } sub upload { my ($self) = @_; return unless $GL_VERSION; my $data; if (exists $self->{data}) { $data = $self->{data}; } elsif (exists $self->{render_cb}) { glViewport 0, 0, $self->{w}, $self->{h}; glMatrixMode GL_PROJECTION; glLoadIdentity; glOrtho 0, $self->{w}, 0, $self->{h}, -10000, 10000; glMatrixMode GL_MODELVIEW; glLoadIdentity; $self->{render_cb}->($self, $self->{w}, $self->{h}); } else { ($self->{w}, $self->{h}, $data, $self->{internalformat}, $self->{format}, $self->{type}) = CFClient::load_image_inline $self->{image}; } my ($tw, $th) = @$self{qw(w h)}; unless ($tw > 0 && $th > 0) { $tw = $th = 1; $data = "\x00" x 64; } $self->{minified} = [CFClient::average $tw, $th, $data] if $self->{minify}; unless ($GL_NPOT) { # TODO: does not work for zero-sized textures $tw = topot $tw; $th = topot $th; if (($tw != $self->{w} || $th != $self->{h}) && defined $data) { my $bpp = (length $data) / ($self->{w} * $self->{h}); $data = pack "(a" . ($tw * $bpp) . ")*", unpack "(a" . ($self->{w} * $bpp) . ")*", $data; $data .= ("\x00" x ($tw * $bpp)) x ($th - $self->{h}); } } $self->{s} = $self->{w} / $tw; $self->{t} = $self->{h} / $th; $self->{name} ||= glGenTexture; glBindTexture GL_TEXTURE_2D, $self->{name}; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP; if ($::FAST) { glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST; } elsif ($self->{mipmap} && $GL_VERSION >= 1.4) { # alternatively check for 0x8191 glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, 1; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR; } else { glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, $self->{mipmap}; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR; } glGetError; if (defined $data) { glTexImage2D GL_TEXTURE_2D, 0, $self->{internalformat}, $tw, $th, 0, $self->{format}, $self->{type}, $data; gl_check "uploading texture %dx%d if=%x f=%x t=%x", $tw, $th, $self->{internalformat}, $self->{format}, $self->{type}; } else { glCopyTexImage2D GL_TEXTURE_2D, 0, $self->{internalformat}, 0, 0, $tw, $th, 0; gl_check "copying to texture %dx%d if=%x", $tw, $th, $self->{internalformat}; } glBindTexture GL_TEXTURE_2D, 0; # just to be on the safe side } sub DESTROY { my ($self) = @_; delete $TEXTURES{$self+0}; glDeleteTexture delete $self->{name} if $self->{name}; } $CFClient::OpenGL::INIT_HOOK{"CFClient::Texture"} = sub { $_->upload for values %TEXTURES; }; 1; =back =head1 AUTHOR Marc Lehmann http://home.schmorp.de/ =cut