--- deliantra/Deliantra-Client/DC.pm 2006/04/06 20:15:10 1.2 +++ deliantra/Deliantra-Client/DC.pm 2006/04/10 22:16:33 1.20 @@ -21,6 +21,233 @@ 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 (); +} + +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 ($GL_NPOT) { + $tw = topot $tw; + $th = topot $th; + + if (defined $data) { + my $bpp = (length $data) / ($self->{width} * $self->{height}); + $data = pack "(a" . ($tw * $bpp) . ")*", + unpack "(a" . ($self->{width} * $bpp) . ")*", $data; + $data .= ("\x00" x ($tw * $bpp)) x ($th - $self->{height}); + } + } + + $self->{s} = $self->{width} / $tw; + $self->{t} = $self->{height} / $th; + + $self->{name} ||= (glGenTextures 1)->[0]; + + 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; + + 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