--- deliantra/Deliantra-Client/DC.pm	2006/04/12 21:35:10	1.30
+++ deliantra/Deliantra-Client/DC.pm	2006/04/18 01:51:06	1.40
@@ -21,6 +21,8 @@
    XSLoader::load "CFClient", $VERSION;
 }
 
+use AnyEvent;
+use BerkeleyDB;
 use SDL::OpenGL;
 
 our %GL_EXT;
@@ -88,6 +90,53 @@
    close CFG;
 }
 
+mkdir "$Crossfire::VARDIR/pclient", 0777;
+
+our $DB_ENV = new BerkeleyDB::Env
+                 -Home => "$Crossfire::VARDIR/pclient",
+                 -Cachesize => 1_000_000,
+                 -ErrFile => "$Crossfire::VARDIR/pclient/errorlog.txt",
+#                 -ErrPrefix => "DATABASE",
+                 -Verbose => 1,
+                 -Flags => DB_CREATE | DB_RECOVER_FATAL | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN,
+                    or die "unable to create/open database home $Crossfire::VARDIR/pclient: $BerkeleyDB::Error";
+
+sub db_table($) {
+   my ($table) = @_;
+
+   $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
+   
+   new CFClient::Database
+      -Env      => $DB_ENV,
+      -Filename => $table,
+#      -Filename => "database",
+#      -Subname  => $table,
+      -Flags    => DB_CREATE | DB_UPGRADE,
+         or die "unable to create/open database table $_[0]: $BerkeleyDB::Error";
+}
+
+package CFClient::Database;
+
+our @ISA = BerkeleyDB::Btree::;
+
+sub get($$) {
+   my $data;
+
+   $_[0]->db_get ($_[1], $data) == 0
+      ? $data
+      : ()
+}
+
+my %DB_SYNC;
+
+sub put($$$) {
+   my ($db, $key, $data) = @_;
+
+   $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });
+
+   $db->db_put ($key => $data)
+}
+
 package CFClient::Texture;
 
 use strict;
@@ -96,7 +145,7 @@
 
 use SDL::OpenGL;
 
-my @textures;
+my %TEXTURES;
 
 sub new {
    my ($class, %data) = @_;
@@ -108,8 +157,7 @@
       %data,
    }, $class;
 
-   push @textures, $self;
-   Scalar::Util::weaken $textures[-1];
+   Scalar::Util::weaken ($TEXTURES{$self+0} = $self);
 
    $self->upload;
 
@@ -117,9 +165,9 @@
 }
 
 sub new_from_image {
-   my ($class, $image) = @_;
+   my ($class, $image, %arg) = @_;
 
-   $class->new (image => $image)
+   $class->new (image => $image, %arg)
 }
 
 sub new_from_file {
@@ -181,12 +229,11 @@
 
    } elsif (exists $self->{render_cb}) {
       glViewport 0, 0, $self->{w}, $self->{h};
-      glOrtho 0, $self->{w}, 0, $self->{h}, -10000, 10000;
       glMatrixMode GL_PROJECTION;
       glLoadIdentity;
+      glOrtho 0, $self->{w}, 0, $self->{h}, -10000, 10000;
       glMatrixMode GL_MODELVIEW;
       glLoadIdentity;
-      glClear GL_COLOR_BUFFER_BIT;
       $self->{render_cb}->($self, $self->{w}, $self->{h});
 
    } else {
@@ -201,6 +248,9 @@
       $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;
@@ -217,6 +267,8 @@
    $self->{s} = $self->{w} / $tw;
    $self->{t} = $self->{h} / $th;
 
+   glGetError;
+
    $self->{name} ||= (glGenTextures 1)->[0];
 
    glBindTexture GL_TEXTURE_2D, $self->{name};
@@ -234,28 +286,32 @@
                    $self->{format},
                    $self->{type},
                    $data;
-      glGetError and die;
+      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};
+      }
    } else {
       glCopyTexImage2D GL_TEXTURE_2D, 0,
                    $self->{internalformat},
                    0, 0,
                    $tw, $th,
                    0;
-      glGetError and die;
+      glGetError and die "glCopyTexImage2D $tw,$th";
    }
 }
 
 sub DESTROY {
    my ($self) = @_;
 
-   return unless exists $self->{name};
+   delete $TEXTURES{$self+0};
 
-   glDeleteTextures delete $self->{name};
+   glDeleteTextures delete $self->{name}
+      if $self->{name};
 }
 
 sub restore_state{
    $_->upload
-      for grep $_, @textures;
+      for values %TEXTURES;
 };
 
 1;