--- deliantra/Deliantra-Client/DC.pm 2006/04/18 01:51:06 1.40 +++ deliantra/Deliantra-Client/DC.pm 2006/05/14 20:51:19 1.51 @@ -21,14 +21,16 @@ XSLoader::load "CFClient", $VERSION; } +use Carp (); use AnyEvent; use BerkeleyDB; -use SDL::OpenGL; +use CFClient::OpenGL; our %GL_EXT; our $GL_VERSION; our $GL_NPOT; +our $GL_DEBUG = 1; sub gl_init { $GL_VERSION = gl_version * 1; @@ -36,21 +38,27 @@ $GL_NPOT = $GL_EXT{GL_ARB_texture_non_power_of_two} || $GL_VERSION >= 2; - glEnable GL_TEXTURE_2D; - glEnable GL_COLOR_MATERIAL; + glDisable GL_COLOR_MATERIAL; glShadeModel GL_FLAT; + glDisable GL_DITHER; glDisable GL_DEPTH_TEST; - glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; - glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_FASTEST; CFClient::Texture::restore_state (); } +sub gl_check { + return unless $GL_DEBUG; + + if (my $error = glGetError) { + Carp::cluck sprintf "opengl error %x while %s", $error, sprintf @_; + } +} + sub find_rcfile($) { my $path; - for (@INC) { + for (grep !ref, @INC) { $path = "$_/CFClient/resources/$_[0]"; return $path if -r $path; } @@ -111,6 +119,7 @@ -Filename => $table, # -Filename => "database", # -Subname => $table, + -Property => DB_CHKSUM, -Flags => DB_CREATE | DB_UPGRADE, or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"; } @@ -143,7 +152,7 @@ use Scalar::Util; -use SDL::OpenGL; +use CFClient::OpenGL; my %TEXTURES; @@ -171,13 +180,13 @@ } sub new_from_file { - my ($class, $path) = @_; + my ($class, $path, %arg) = @_; open my $fh, "<:raw", $path or die "$path: $!"; local $/; - $class->new_from_image (<$fh>) + $class->new_from_image (<$fh>, %arg) } #sub new_from_surface { @@ -193,24 +202,25 @@ #} sub new_from_layout { - my ($class, $layout) = @_; + my ($class, $layout, %arg) = @_; - my ($w, $h, $data) = $layout->render; + my ($w, $h, $data, $format, $internalformat) = $layout->render; $class->new ( w => $w, h => $h, data => $data, - internalformat => GL_ALPHA4, - format => GL_ALPHA, + format => $format, + internalformat => $format, type => GL_UNSIGNED_BYTE, + %arg, ) } sub new_from_opengl { my ($class, $w, $h, $cb) = @_; - $class->new (w => $w, h => $h, render_cb => $cb) + $class->new (w => $w || 1, h => $h || 1, render_cb => $cb) } sub topot { @@ -243,7 +253,7 @@ my ($tw, $th) = @$self{qw(w h)}; - unless ($tw && $th) { + unless ($tw > 0 && $th > 0) { $tw = $th = 1; $data = "\x00" x 64; } @@ -256,7 +266,7 @@ $tw = topot $tw; $th = topot $th; - if ($tw != $self->{w} || $th != $self->{h} && defined $data) { + 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; @@ -267,17 +277,29 @@ $self->{s} = $self->{w} / $tw; $self->{t} = $self->{h} / $th; - glGetError; - - $self->{name} ||= (glGenTextures 1)->[0]; + $self->{name} ||= glGenTexture; glBindTexture GL_TEXTURE_2D, $self->{name}; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, $::FAST ? GL_NEAREST : GL_LINEAR; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, $::FAST ? GL_NEAREST : GL_LINEAR; 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}, @@ -286,17 +308,16 @@ $self->{format}, $self->{type}, $data; - if (my $error = glGetError) { - warn sprintf "texture upload error: %x %dx%d i=%x f=%x t=%x\n", - $error, $tw, $th, $self->{internalformat}, $self->{format}, $self->{type}; - } + CFClient::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; - glGetError and die "glCopyTexImage2D $tw,$th"; + CFClient::gl_check "copying to texture %dx%d if=%x", + $tw, $th, $self->{internalformat}; } } @@ -305,7 +326,7 @@ delete $TEXTURES{$self+0}; - glDeleteTextures delete $self->{name} + glDeleteTexture delete $self->{name} if $self->{name}; }