--- deliantra/Deliantra-Client/DC.pm 2006/04/25 11:18:48 1.48 +++ deliantra/Deliantra-Client/DC.pm 2006/05/23 23:14:44 1.60 @@ -22,32 +22,42 @@ } use Carp (); -use AnyEvent; +use AnyEvent (); use BerkeleyDB; + use CFClient::OpenGL; our %GL_EXT; our $GL_VERSION; our $GL_NPOT; +our $GL_DEBUG = 1; 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; + $GL_NPOT = 0 if gl_vendor =~ /ATI Technologies/; # ATI doesn't get it right... - 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; - + glDepthMask 0; 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; @@ -99,7 +109,7 @@ -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, + -Flags => DB_CREATE | DB_RECOVER | 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($) { @@ -112,10 +122,78 @@ -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"; } +sub pod_to_pango($) { + my ($pom) = @_; + + $pom->present ("CFClient::PodToPango") +} + +sub pod_to_pango_list($) { + my ($pom) = @_; + + [ + map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "], + split /\n/, $pom->present ("CFClient::PodToPango") + ] +} + +package CFClient::PodToPango; + +use base Pod::POM::View::Text; + +our $indent = 0; + +*view_seq_code = +*view_seq_bold = sub { "$_[1]" }; +*view_seq_italic = sub { "$_[1]" }; +*view_seq_space = +*view_seq_link = +*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) }; + +sub view_seq_text { + my $text = $_[1]; + $text =~ s/\s+/ /g; + CFClient::UI::Label::escape ($text) +} + +sub view_item { + ("\t" x ($indent / 4)) + . $_[1]->title->present ($_[0]) + . "\n" + . $_[1]->content->present ($_[0]) +} + +sub view_verbatim { + (join "", + map +("\t" x ($indent / 2)) . "$_\n", + split /\n/, CFClient::UI::Label::escape ($_[1])) + . "\n" +} + +sub view_textblock { + ("\t" x ($indent / 2)) . "$_[1]\n\n" +} + +sub view_head1 { + "" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; + +sub view_head2 { + "" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; + +sub view_over { + local $indent = $indent + $_[1]->indent; + $_[1]->content->present ($_[0]) +} + package CFClient::Database; our @ISA = BerkeleyDB::Btree::; @@ -196,14 +274,14 @@ sub new_from_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, - format => GL_ALPHA, - internalformat => GL_ALPHA, + format => $format, + internalformat => $format, type => GL_UNSIGNED_BYTE, %arg, ) @@ -295,26 +373,24 @@ if (defined $data) { glTexImage2D GL_TEXTURE_2D, 0, $self->{internalformat}, - $tw, $th, # need to pad texture first + $tw, $th, 0, $self->{format}, $self->{type}, $data; - if (my $error = glGetError) { - Carp::cluck sprintf "texture upload error: %x %dx%d i=%x f=%x t=%x", - $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; - if (my $error = glGetError) { - Carp::cluck sprintf "texture upload error: %x %dx%d i=%x", - $error, $tw, $th, $self->{internalformat}; - } + CFClient::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 { @@ -326,10 +402,10 @@ if $self->{name}; } -sub restore_state{ +sub restore_state { $_->upload for values %TEXTURES; -}; +} 1;