--- deliantra/Deliantra-Client/DC.pm 2006/04/10 22:16:33 1.20 +++ deliantra/Deliantra-Client/DC.pm 2006/08/15 06:30:05 1.115 @@ -1,10 +1,10 @@ =head1 NAME -Crossfire::Client - undocumented utility garbage for our crossfire client +CFPlus - undocumented utility garbage for our crossfire client =head1 SYNOPSIS - use Crossfire::Client; + use CFPlus; =head1 DESCRIPTION @@ -12,242 +12,372 @@ =cut -package Crossfire::Client; +package CFPlus; BEGIN { - $VERSION = '0.1'; + $VERSION = '0.2'; use XSLoader; - XSLoader::load "Crossfire::Client", $VERSION; + XSLoader::load "CFPlus", $VERSION; } -our %GL_EXT; -our $GL_VERSION; +use utf8; -our $GL_NPOT; +use Carp (); +use AnyEvent (); +use BerkeleyDB; +use Pod::POM (); +use Scalar::Util (); +use Storable (); # finally -sub gl_init { - $GL_VERSION = gl_version * 1; - %GL_EXT = map +($_ => 1), split /\s+/, gl_extensions; +=item guard { BLOCK } - $GL_NPOT = $GL_EXT{GL_ARB_texture_non_power_of_two} || $GL_VERSION >= 2; +Returns an object that executes the given block as soon as it is destroyed. - Crossfire::Client::Texture::restore_state (); +=cut + +sub guard(&) { + bless \(my $cb = $_[0]), "CFPlus::Guard" } -sub find_rcfile($) { - my $path; +sub CFPlus::Guard::DESTROY { + ${$_[0]}->() +} - for (@INC) { - $path = "$_/Crossfire/resources/$_[0]"; - return $path if -r $path; - } +sub asxml($) { + local $_ = $_[0]; - die "FATAL: can't find required file $_[0]\n"; + s/&/&/g; + s/>/>/g; + s/; + $_[0]->db_get ($_[1], $data) == 0 + ? $data + : () +} + +my %DB_SYNC; - $::CFG = $CFG; +sub put($$$) { + my ($db, $key, $data) = @_; - close CFG; + $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); + + $db->db_put ($key => $data) } -sub write_cfg { - my ($file) = @_; +package CFPlus; - open CFG, ">$file" - or return; +sub find_rcfile($) { + my $path; - { - require Data::Dumper; - local $Data::Dumper::Purity = 1; - $::CFG->{VERSION} = $::VERSION; - print CFG Data::Dumper->Dump ([$::CFG], [qw/CFG/]); + for (grep !ref, @INC) { + $path = "$_/CFPlus/resources/$_[0]"; + return $path if -r $path; } - close CFG; + die "FATAL: can't find required file $_[0]\n"; } -package Crossfire::Client::Texture; - -use Scalar::Util; +BEGIN { + use Crossfire::Protocol::Base (); + *to_json = \&Crossfire::Protocol::Base::to_json; + *from_json = \&Crossfire::Protocol::Base::from_json; +} -use SDL::OpenGL; +sub read_cfg { + my ($file) = @_; -my @textures; + open my $fh, $file + or return; -sub new { - my ($class, %data) = @_; + local $/; + my $CFG = <$fh>; - my $self = bless { - internalformat => GL_RGBA, - format => GL_RGBA, - %data, - }, $class; + if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove + require YAML; + utf8::decode $CFG; + $::CFG = YAML::Load ($CFG); + } elsif ($CFG =~ /^\{/) { + $::CFG = from_json $CFG; + } else { + $::CFG = eval $CFG; ## todo comaptibility cruft + } +} - push @textures, $self; - Scalar::Util::weaken $textures[-1]; +sub write_cfg { + my ($file) = @_; - $self->upload; + $::CFG->{VERSION} = $::VERSION; - $self + open my $fh, ">:utf8", $file + or return; + print $fh to_json $::CFG; } -sub new_from_image { - my ($class, $image) = @_; +our $DB_ENV; + +{ + use strict; + + mkdir "$Crossfire::VARDIR/cfplus", 0777; + my $recover = $BerkeleyDB::db_version >= 4.4 + ? eval "DB_REGISTER | DB_RECOVER" + : 0; - $class->new (image => $image) + $DB_ENV = new BerkeleyDB::Env + -Home => "$Crossfire::VARDIR/cfplus", + -Cachesize => 1_000_000, + -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt", +# -ErrPrefix => "DATABASE", + -Verbose => 1, + -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover, + -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, + or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error"; } -sub new_from_file { - my ($class, $path) = @_; +sub db_table($) { + my ($table) = @_; - open my $fh, "<:raw", $path - or die "$path: $!"; + $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; - local $/; - $class->new_from_image (<$fh>) + new CFPlus::Database + -Env => $DB_ENV, + -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 new_from_surface { -# my ($class, $surface) = @_; -# -# $surface->rgba; -# -# $class->new ( -# data => $surface->pixels, -# width => $surface->width, -# height => $surface->height, -# ) -#} +package CFPlus::Layout; -sub new_from_text { - my ($class, $text, $height) = @_; +$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { + reset_glyph_cache; +}; - my ($w, $h, $data) = Crossfire::Client::font_render $text, $height; +package CFPlus::Item; - $class->new ( - width => $w, - height => $h, - data => $data, - internalformat => GL_ALPHA4, - format => GL_ALPHA, - ) -} +use strict; +use Crossfire::Protocol::Constants; -sub new_from_opengl { - my ($class, $w, $h, $cb) = @_; +my $last_enter_count = 1; - $class->new (width => $w, height => $h, rendercb => $cb) -} +sub desc_string { + my ($self) = @_; + + my $desc = + $self->{nrof} < 2 + ? $self->{name} + : "$self->{nrof} × $self->{name_pl}"; + + $self->{flags} & F_OPEN + and $desc .= " (open)"; + $self->{flags} & F_APPLIED + and $desc .= " (applied)"; + $self->{flags} & F_UNPAID + and $desc .= " (unpaid)"; + $self->{flags} & F_MAGIC + and $desc .= " (magic)"; + $self->{flags} & F_CURSED + and $desc .= " (cursed)"; + $self->{flags} & F_DAMNED + and $desc .= " (damned)"; + $self->{flags} & F_LOCKED + and $desc .= " *"; -sub topot { - (grep $_ >= $_[0], 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768)[0] + $desc } -sub upload { +sub weight_string { my ($self) = @_; - return unless $SDL::App::USING_OPENGL; + my $weight = ($self->{nrof} || 1) * $self->{weight}; - my $data; + $weight < 0 ? "?" : $weight * 0.001 +} - 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; +sub do_n_dialog { + my ($cb) = @_; - $self->{rendercb}->($self, $self->{width}, $self->{height}); - } else { - my $pb = new Gtk2::Gdk::PixbufLoader; - $pb->write ($self->{image}); - $pb->close; + my $w = new CFPlus::UI::Toplevel + on_delete => sub { $_[0]->destroy; 1 }, + has_close_button => 1, + ; + + $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center"); + $vb->add (new CFPlus::UI::Label text => "Enter item count:"); + $vb->add (my $entry = new CFPlus::UI::Entry + text => $last_enter_count, + on_activate => sub { + my ($entry) = @_; + $last_enter_count = $entry->get_text; + $cb->($last_enter_count); + $w->hide; + $w->destroy; + + 0 + }, + on_escape => sub { $w->destroy; 1 }, + ); + $entry->grab_focus; + $w->show; +} - $pb = $pb->get_pixbuf; - $pb = $pb->add_alpha (0, 0, 0, 0); +sub update_widgets { + my ($self) = @_; - $self->{width} = $pb->get_width; - $self->{height} = $pb->get_height; + # necessary to avoid cyclic references + Scalar::Util::weaken $self; - $data = $pb->get_pixels; - } + my $button_cb = sub { + my (undef, $ev, $x, $y) = @_; - my ($tw, $th) = @$self{qw(width height)}; + my $targ = $::CONN->{player}{tag}; - 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}); + if ($self->{container} == $::CONN->{player}{tag}) { + $targ = $::CONN->{open_container}; } - } - $self->{s} = $self->{width} / $tw; - $self->{t} = $self->{height} / $th; + if (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 1) { + $::CONN->send ("move $targ $self->{tag} 0") + if $targ || !($self->{flags} & F_LOCKED); + } elsif (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 2) { + $self->{flags} & F_LOCKED + ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) + : $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) + } elsif ($ev->{button} == 1) { + $::CONN->send ("examine $self->{tag}"); + } elsif ($ev->{button} == 2) { + $::CONN->send ("apply $self->{tag}"); + } elsif ($ev->{button} == 3) { + my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop'; + if ($self->{container} == $::CONN->{open_container}) { + $move_prefix = "take"; + } + + my @menu_items = ( + ["examine", sub { $::CONN->send ("examine $self->{tag}") }], + ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }], + ["ignite/thaw", # first try of an easier use of flint&steel + sub { + $::CONN->send ("mark ". pack "N", $self->{tag}); + $::CONN->send ("command apply flint and steel"); + } + ], + ["inscribe", # first try of an easier use of flint&steel + sub { + &::open_string_query ("Text to inscribe", sub { + my ($entry, $txt) = @_; + $::CONN->send ("mark ". pack "N", $self->{tag}); + $::CONN->send ("command use_skill inscription $txt"); + }); + } + ], + ["rename", # first try of an easier use of flint&steel + sub { + &::open_string_query ("Rename item to:", sub { + my ($entry, $txt) = @_; + $::CONN->send ("mark ". pack "N", $self->{tag}); + $::CONN->send ("command rename to <$txt>"); + }, $self->{name}, + "If you input no name or erase the current custom name, the custom name will be unset"); + } + ], + ["apply", sub { $::CONN->send ("apply $self->{tag}") }], + ( + $self->{flags} & F_LOCKED + ? ( + ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }], + ) + : ( + ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }], + ["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }], + ["$move_prefix <n>", + sub { + do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") }) + } + ] + ) + ), + ); - $self->{name} ||= (glGenTextures 1)->[0]; + CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev); + } - glBindTexture GL_TEXTURE_2D, $self->{name}; + 1 + }; - 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; + my $tooltip_std = "" + . "Left click - examine item\n" + . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n" + . "Middle click - apply\n" + . "Shift-Middle click - lock/unlock\n" + . "Right click - further options" + . "\n"; + + my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5] + : $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5] + : undef; + + $self->{face_widget} ||= new CFPlus::UI::Face + can_events => 1, + can_hover => 1, + anim => $self->{anim}, + animspeed => $self->{animspeed}, # TODO# must be set at creation time + on_button_down => $button_cb, + ; + $self->{face_widget}{bg} = $bg; + $self->{face_widget}{face} = $self->{face}; + $self->{face_widget}{anim} = $self->{anim}; + $self->{face_widget}{animspeed} = $self->{animspeed}; + $self->{face_widget}->set_tooltip ( + "Face/Animation.\n" + . "Item uses face #$self->{face}. " + . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ") + . "\n\n$tooltip_std" + ); - 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; - } + $self->{desc_widget} ||= new CFPlus::UI::Label + can_events => 1, + can_hover => 1, + ellipsise => 2, + align => -1, + on_button_down => $button_cb, + ; + my $desc = CFPlus::Item::desc_string $self; + $self->{desc_widget}{bg} = $bg; + $self->{desc_widget}->set_text ($desc); + $self->{desc_widget}->set_tooltip ("$desc.\n$tooltip_std"); + + $self->{weight_widget} ||= new CFPlus::UI::Label + can_events => 1, + can_hover => 1, + ellipsise => 0, + align => 0, + on_button_down => $button_cb, + ; + $self->{weight_widget}{bg} = $bg; + $self->{weight_widget}->set_text (CFPlus::Item::weight_string $self); + $self->{weight_widget}->set_tooltip ( + "Weight.\n" + . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ") + . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ") + . "\n\n$tooltip_std" + ); } -sub DESTROY { - my ($self) = @_; - - return unless exists $self->{name}; - - glDeleteTextures delete $self->{name}; -} - -sub restore_state{ - $_->upload - for grep $_, @textures; -}; - 1; =back