--- deliantra/Deliantra-Client/DC.pm 2006/04/06 15:30:09 1.1 +++ deliantra/Deliantra-Client/DC.pm 2006/07/14 17:35:34 1.99 @@ -1,10 +1,10 @@ =head1 NAME -Crossfire::Client - undocumented utility garbage for our crossfire client +CFClient - undocumented utility garbage for our crossfire client =head1 SYNOPSIS - use Crossfire::Client; + use CFClient; =head1 DESCRIPTION @@ -12,14 +12,410 @@ =cut -package Crossfire::Client; +package CFClient; BEGIN { $VERSION = '0.1'; - @ISA = qw(Exporter); - require XSLoader; - XSLoader::load "Crossfire::Client", $VERSION; + use XSLoader; + XSLoader::load "CFClient", $VERSION; +} + +use utf8; + +use Carp (); +use AnyEvent (); +use BerkeleyDB; +use Pod::POM (); +use Scalar::Util (); +use Storable (); # finally + +package CFClient::PodToPango; + +use base Pod::POM::View::Text; + +our $VERSION = 1; # bump if resultant formatting changes + +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\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 { + "\n\n" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; + +sub view_head2 { + "\n" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; + +sub view_head3 { + "\n" . $_[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::; + +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; + +sub find_rcfile($) { + my $path; + + for (grep !ref, @INC) { + $path = "$_/CFClient/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; +} + +our $DB_ENV; + +{ + use strict; + + mkdir "$Crossfire::VARDIR/cfplus", 0777; + my $recover = $BerkeleyDB::db_version >= 4.4 + ? eval "DB_REGISTER | DB_RECOVER" + : 0; + + $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 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, + -Property => DB_CHKSUM, + -Flags => DB_CREATE | DB_UPGRADE, + or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" +} + +my $pod_cache = db_table "pod_cache"; + +sub load_pod($$$$) { + my ($path, $filtertype, $filterversion, $filtercb) = @_; + + stat $path + or die "$path: $!"; + + my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9]; + + my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } }; + + return $pom if $chash eq $phash; + + my $pod = do { + local $/; + open my $pod, "<:utf8", $_[0] + or die "$_[0]: $!"; + <$pod> + }; + + #utf8::downgrade $pod; + + $pom = $filtercb-> (Pod::POM->new->parse_text ($pod)); + + $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]); + + $pom +} + +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::Layout; + +$CFClient::OpenGL::SHUTDOWN_HOOK{"CFClient::Layout"} = sub { + reset_glyph_cache; +}; + +package CFClient::Item; + +use strict; +use Crossfire::Protocol::Constants; + +my $last_enter_count = 1; + +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 .= " *"; + + $desc +} + +sub weight_string { + my ($self) = @_; + + my $weight = ($self->{nrof} || 1) * $self->{weight}; + + $weight < 0 ? "?" : $weight * 0.001 +} + +sub do_n_dialog { + my ($cb) = @_; + + my $w = new CFClient::UI::FancyFrame; + $w->add (my $vb = new CFClient::UI::VBox x => "center", y => "center"); + $vb->add (new CFClient::UI::Label text => "Enter item count:"); + $vb->add (my $entry = new CFClient::UI::Entry + text => $last_enter_count, + on_activate => sub { + my ($entry) = @_; + $last_enter_count = $entry->get_text; + $cb->($last_enter_count); + $w->hide; + $w = undef; + } + ); + $entry->grab_focus; + $w->show; + +} + +sub update_widgets { + my ($self) = @_; + + # necessary to avoid cyclic references + Scalar::Util::weaken $self; + + my $button_cb = sub { + my (undef, $ev, $x, $y) = @_; + + my $targ = $::CONN->{player}{tag}; + + if ($self->{container} == $::CONN->{player}{tag}) { + $targ = $::CONN->{open_container}; + } + + if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) { + $::CONN->send ("move $targ $self->{tag} 0") + if $targ || !($self->{flags} & F_LOCKED); + } elsif (($ev->{mod} & CFClient::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 @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"); + } + ], + ["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}) }], + ["drop", sub { $::CONN->send ("move $::CONN->{open_container} $self->{tag} 0") }], + ["move n", + sub { + do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") }) + } + ] + ) + ), + ); + + CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); + } + + 1 + }; + + 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"; + + $self->{face_widget} ||= new CFClient::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}{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" + ); + + $self->{desc_widget} ||= new CFClient::UI::Label + can_events => 1, + can_hover => 1, + ellipsise => 2, + align => -1, + on_button_down => $button_cb, + ; + my $desc = CFClient::Item::desc_string $self; + $self->{desc_widget}->set_text ($desc); + $self->{desc_widget}->set_tooltip ("$desc.\n$tooltip_std"); + + $self->{weight_widget} ||= new CFClient::UI::Label + can_events => 1, + can_hover => 1, + ellipsise => 0, + align => 0, + on_button_down => $button_cb, + ; + $self->{weight_widget}->set_text (CFClient::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" + ); } 1;