=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; } our %GL_EXT; our $GL_VERSION; our $GL_NPOT; sub gl_init { $GL_VERSION = gl_version * 1; %GL_EXT = map +($_ => 1), split /\s+/, gl_extensions; $GL_NPOT = $GL_EXT{GL_ARB_texture_non_power_of_two} || $GL_VERSION >= 2; Crossfire::Client::Texture::restore_state (); # $GL_NPOT=0;#d# } sub find_rcfile($) { my $path; for (@INC) { $path = "$_/Crossfire/resources/$_[0]"; return $path if -r $path; } die "FATAL: can't find required file $_[0]\n"; } sub read_cfg { my ($file) = @_; open CFG, $file or return; my $CFG; local $/; $CFG = eval ; $::CFG = $CFG; close CFG; } sub write_cfg { my ($file) = @_; open CFG, ">$file" or return; { require Data::Dumper; local $Data::Dumper::Purity = 1; $::CFG->{VERSION} = $::VERSION; print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]); } close CFG; } package Crossfire::Client::Texture; use Scalar::Util; use SDL::OpenGL; my @textures; sub new { my ($class, %data) = @_; my $self = bless { internalformat => GL_RGBA, format => GL_RGBA, %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 new_from_text { my ($class, $text, $height) = @_; my ($w, $h, $data) = Crossfire::Client::font_render $text, $height; $class->new ( width => $w, height => $h, data => $data, internalformat => GL_ALPHA4, format => GL_ALPHA, ) } sub new_from_opengl { my ($class, $w, $h, $cb) = @_; $class->new (width => $w, height => $h, rendercb => $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 $SDL::App::USING_OPENGL; my $data; if (exists $self->{data}) { $data = $self->{data}; } elsif (exists $self->{rendercb}) { glViewport 0, 0, $self->{width}, $self->{height}; glMatrixMode GL_PROJECTION; glLoadIdentity; glOrtho 0, $self->{width}, 0, $self->{height}, -10000, 10000; glMatrixMode GL_MODELVIEW; glPushmatrix; glLoadIdentity; glClear GL_COLOR_BUFFER_BIT; $self->{rendercb}->($self, $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); $self->{width} = $pb->get_width; $self->{height} = $pb->get_height; $data = $pb->get_pixels; } my ($tw, $th) = @$self{qw(width height)}; unless ($NPOT) { $tw = topot $tw; $th = topot $th; if (defined $data) { $data = pack "(a$tw)*", (unpack "(a$self->{width})*", $data); $data .= ("\x00" x $tw) x ($th - $self->{height}); } } $self->{u} = $self->{width} / $tw; $self->{v} = $self->{height} / $th; $self->{name} ||= (glGenTextures 1)->[0]; glBindTexture GL_TEXTURE_2D, $self->{name}; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST;#_MIPMAP_LINEAR; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP; glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP; glGetError; if (defined $data) { glTexImage2D GL_TEXTURE_2D, 0, $self->{internalformat}, $tw, $th, # need to pad texture first 0, $self->{format}, GL_UNSIGNED_BYTE, $data; glGetError and die; } else { glCopyTexImage2D GL_TEXTURE_2D, 0, $self->{internalformat}, 0, 0, $tw, $th, 0; glPopmatrix; } } sub DESTROY { my ($self) = @_; return unless exists $self->{name}; glDeleteTextures delete $self->{name}; } sub restore_state{ $_->upload for grep $_, @textures; }; 1; =back =head1 AUTHOR Marc Lehmann http://home.schmorp.de/ =cut