--- deliantra/Deliantra-Client/DC.pm 2006/05/29 19:49:33 1.74 +++ deliantra/Deliantra-Client/DC.pm 2006/07/16 20:04:07 1.100 @@ -26,6 +26,92 @@ 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; @@ -70,22 +156,32 @@ close CFG; } -mkdir "$Crossfire::VARDIR/pclient", 0777; +our $DB_ENV; -our $DB_ENV = new BerkeleyDB::Env - -Home => "$Crossfire::VARDIR/pclient", - -Cachesize => 1_000_000, - -ErrFile => "$Crossfire::VARDIR/pclient/errorlog.txt", +{ + 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, - or die "unable to create/open database home $Crossfire::VARDIR/pclient: $BerkeleyDB::Error"; + -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, @@ -93,108 +189,67 @@ # -Subname => $table, -Property => DB_CHKSUM, -Flags => DB_CREATE | DB_UPGRADE, - or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"; + or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" } -sub pod_to_pango($) { - my ($pom) = @_; +my $pod_cache = db_table "pod_cache"; - $pom->present ("CFClient::PodToPango") -} +sub load_pod($$$$) { + my ($path, $filtertype, $filterversion, $filtercb) = @_; -sub pod_to_pango_list($) { - my ($pom) = @_; + stat $path + or die "$path: $!"; - [ - map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "], - split /\n/, $pom->present ("CFClient::PodToPango") - ] -} + my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9]; -package CFClient::PodToPango; + my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } }; -use base Pod::POM::View::Text; + return $pom if $chash eq $phash; -our $indent = 0; + my $pod = do { + local $/; + open my $pod, "<:utf8", $_[0] + or die "$_[0]: $!"; + <$pod> + }; -*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]) }; + #utf8::downgrade $pod; -sub view_seq_text { - my $text = $_[1]; - $text =~ s/\s+/ /g; - CFClient::UI::Label::escape ($text) -} + $pom = $filtercb-> (Pod::POM->new->parse_text ($pod)); -sub view_item { - ("\t" x ($indent / 4)) - . $_[1]->title->present ($_[0]) - . "\n" - . $_[1]->content->present ($_[0]) -} + $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]); -sub view_verbatim { - (join "", - map +("\t" x ($indent / 2)) . "$_\n", - split /\n/, CFClient::UI::Label::escape ($_[1])) - . "\n" + $pom } -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 pod_to_pango($) { + my ($pom) = @_; -sub view_over { - local $indent = $indent + $_[1]->indent; - $_[1]->content->present ($_[0]) + $pom->present ("CFClient::PodToPango") } -package CFClient::Database; - -our @ISA = BerkeleyDB::Btree::; - -sub get($$) { - my $data; +sub pod_to_pango_list($) { + my ($pom) = @_; - $_[0]->db_get ($_[1], $data) == 0 - ? $data - : () + [ + map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "], + split /\n/, $pom->present ("CFClient::PodToPango") + ] } -my %DB_SYNC; - -sub put($$$) { - my ($db, $key, $data) = @_; - - $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); +package CFClient::Layout; - $db->db_put ($key => $data) -} +$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) = @_; @@ -229,20 +284,55 @@ $weight < 0 ? "?" : $weight * 0.001 } +sub do_n_dialog { + my ($cb) = @_; + + my $w = new CFClient::UI::FancyFrame + on_delete => sub { $_[0]->destroy; 1 }, + has_close_button => 1, + ; + + $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->destroy; + + 0 + }, + on_escape => sub { $w->destroy; 1 }, + ); + $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) = @_; - if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) { - my $targ = $::CONN->{player}{tag}; + my $targ = $::CONN->{player}{tag}; - if ($self->{container} == $::CONN->{player}{tag}) { - $targ = $::CONN->{open_container}; - } + if ($self->{container} == $::CONN->{player}{tag}) { + $targ = $::CONN->{open_container}; + } - $::CONN->send ("move $targ $self->{tag} 0"); + 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) { @@ -251,6 +341,12 @@ 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 @@ -260,6 +356,11 @@ : ( ["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]") }) + } + ] ) ), ); @@ -274,6 +375,7 @@ . "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"; @@ -322,217 +424,6 @@ ); } -package CFClient::Recorder; - -our $RECORD_WINDOW; - -my $CMDBOX; -my $CURRENT_CMDS; -my $REC_BTN; - -my @ALLOWED_MODIFIER_KEYS = ( - (CFClient::SDLK_LSHIFT) => "LSHIFT", - (CFClient::SDLK_LCTRL ) => "LCTRL", - (CFClient::SDLK_LALT ) => "LALT", - (CFClient::SDLK_LMETA ) => "LMETA", - - (CFClient::SDLK_RSHIFT) => "RSHIFT", - (CFClient::SDLK_RCTRL ) => "RCTRL", - (CFClient::SDLK_RALT ) => "RALT", - (CFClient::SDLK_RMETA ) => "RMETA", -); - -my %ALLOWED_MODIFIERS = ( - (CFClient::KMOD_LSHIFT) => "LSHIFT", - (CFClient::KMOD_LCTRL ) => "LCTRL", - (CFClient::KMOD_LALT ) => "LALT", - (CFClient::KMOD_LMETA ) => "LMETA", - - (CFClient::KMOD_RSHIFT) => "RSHIFT", - (CFClient::KMOD_RCTRL ) => "RCTRL", - (CFClient::KMOD_RALT ) => "RALT", - (CFClient::KMOD_RMETA ) => "RMETA", -); - -my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/; -my @DIRECT_BIND_KEYS = ( - CFClient::SDLK_F1, - CFClient::SDLK_F2, - CFClient::SDLK_F3, - CFClient::SDLK_F4, - CFClient::SDLK_F5, - CFClient::SDLK_F6, - CFClient::SDLK_F7, - CFClient::SDLK_F8, - CFClient::SDLK_F9, - CFClient::SDLK_F10, - CFClient::SDLK_F11, - CFClient::SDLK_F12, - CFClient::SDLK_F13, - CFClient::SDLK_F14, - CFClient::SDLK_F15, -); - -# this binding dialog asks for a key-combo to be pressed -# and if successful it binds the modifier+symbol to the -# supplied actions in $cmd. -# (Bindings are stored in $::CFG->{bindings}->{$mod}->{$sym}) -sub open_binding_dialog { - my ($cmd) = @_; - - my $w = new CFClient::UI::FancyFrame - title => "Bind Action"; - - $w->add (my $vb = new CFClient::UI::VBox); - $vb->add (new CFClient::UI::Label - text => "Press a modifier (CTRL, ALT and/or SHIFT) and a key." - ."You can only bind 0-9 and F1-F15 without modifiers." - ); - $vb->add (my $entry = new CFClient::UI::Entry - text => "", - on_key_down => sub { - my ($entry, $ev) = @_; - - my $mod = $ev->{mod}; - my $sym = $ev->{sym}; - - # XXX: This seems a little bit hackisch to me, but i have to ignore them - if (grep { $_ == $sym } @ALLOWED_MODIFIER_KEYS) { - return; - } - - if ($mod == CFClient::KMOD_NONE - and not $DIRECT_BIND_CHARS{chr ($ev->{unicode})} - and not grep { $sym == $_ } @DIRECT_BIND_KEYS) - { - $::STATUSBOX->add ( - "Can't bind key ".CFClient::SDL_GetKeyName ($sym) - ." directly without modifier! It would damage the completer handling." - ); - return; - } - - $entry->focus_out; - - $::CFG->{bindings}->{$mod}->{$sym} = $cmd; - $::STATUSBOX->add ("Bound actions to '".keycombo_to_name ($mod, $sym)."'. Don't forget 'Save Config'!"); - - $w->destroy - }); - - $entry->focus_in; - $w->center; - $w->show; -} - -sub keycombo_to_name { - my ($mod, $sym) = @_; - - my $mods = join '+', - map { $ALLOWED_MODIFIERS{$_} } - grep { $_ & $mod } - keys %ALLOWED_MODIFIERS; - $mods .= "+" if $mods ne ''; - - return $mods . CFClient::SDL_GetKeyName ($sym); -} - -sub clear_command_list { - $CMDBOX->clear () if $CMDBOX; -} - -sub set_command_list { - my ($list) = @_; - - return unless $CMDBOX; - - $CMDBOX->clear (); - $CURRENT_CMDS = $list; - - my $idx = 0; - - for (@$list) { - $CMDBOX->add (my $hb = new CFClient::UI::HBox); - - my $i = $idx; - $hb->add (new CFClient::UI::Button - text => "delete", - tooltip => "Deletes the action from the record", - on_activate => sub { - $CMDBOX->remove ($hb); - $list->[$i] = undef; - }); - - $hb->add (new CFClient::UI::Label text => $_); - - $idx++ - } -} - -# if $show is 1 the recorder will be shown -sub start { - my ($show) = @_; - - $RECORD_WINDOW->show if $show; - - $REC_BTN->set_text ("stop recording"); - $REC_BTN->{recording} = 1; - clear_command_list; - $::CONN->start_record; -} - -# if $autobind is 1 the recorder will be automatically -# jump into the binding query and hide the recorder window -sub stop { - my ($autobind) = @_; - - $REC_BTN->set_text ("start recording"); - $REC_BTN->{recording} = 0; - - my $rec = $::CONN->stop_record; - return unless ref $rec eq 'ARRAY'; - set_command_list ($rec); - - if ($autobind) { - open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]); - $RECORD_WINDOW->hide; - } -} - -sub make_window { - $RECORD_WINDOW = new CFClient::UI::FancyFrame - req_y => 1, - req_x => -1, - title => "Action Recorder"; - - $RECORD_WINDOW->add (my $vb = new CFClient::UI::VBox); - $vb->add ($REC_BTN = new CFClient::UI::Button - text => "start recording", - tooltip => "Start/Stops recording of actions." - ."(CTRL+Insert Starts the recorder, Insert Stops recorder and binds automatically)" - ."All subsequent actions after the recording started will be captured." - ."The actions are displayed after the record was stopped." - ."To bind the action you have to click on the 'Bind' button", - on_activate => sub { - my ($btn) = @_; - - unless ($btn->{recording}) { - start; - } else { - stop; - } - }); - $vb->add ($CMDBOX = new CFClient::UI::VBox); - $vb->add (new CFClient::UI::Button - text => "bind", - tooltip => "This opens a query where you have to press the key combination to bind the recorded actions", - on_activate => sub { - open_binding_dialog ([ grep { defined $_ } @$CURRENT_CMDS ]); - }); - - $RECORD_WINDOW -} - 1; =back