--- deliantra/Deliantra-Client/DC.pm 2006/06/02 16:27:27 1.86 +++ deliantra/Deliantra-Client/DC.pm 2006/07/14 17:35:34 1.99 @@ -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,13 +156,12 @@ close CFG; } -mkdir "$Crossfire::VARDIR/cfplus", 0777; - our $DB_ENV; { use strict; + mkdir "$Crossfire::VARDIR/cfplus", 0777; my $recover = $BerkeleyDB::db_version >= 4.4 ? eval "DB_REGISTER | DB_RECOVER" : 0; @@ -107,99 +192,56 @@ or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" } -sub pod_to_pango($) { - my ($pom) = @_; - - $pom->present ("CFClient::PodToPango") -} +my $pod_cache = db_table "pod_cache"; -sub pod_to_pango_list($) { - my ($pom) = @_; +sub load_pod($$$$) { + my ($path, $filtertype, $filterversion, $filtercb) = @_; - [ - map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "], - split /\n/, $pom->present ("CFClient::PodToPango") - ] -} + stat $path + or die "$path: $!"; -package CFClient::PodToPango; + my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9]; -use base Pod::POM::View::Text; + my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } }; -our $indent = 0; + return $pom if $chash eq $phash; -*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]) }; + my $pod = do { + local $/; + open my $pod, "<:utf8", $_[0] + or die "$_[0]: $!"; + <$pod> + }; -sub view_seq_text { - my $text = $_[1]; - $text =~ s/\s+/ /g; - CFClient::UI::Label::escape ($text) -} + #utf8::downgrade $pod; -sub view_item { - ("\t" x ($indent / 4)) - . $_[1]->title->present ($_[0]) - . "\n" - . $_[1]->content->present ($_[0]) -} + $pom = $filtercb-> (Pod::POM->new->parse_text ($pod)); -sub view_verbatim { - (join "", - map +("\t" x ($indent / 2)) . "$_\n", - split /\n/, CFClient::UI::Label::escape ($_[1])) - . "\n" -} + $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]); -sub view_textblock { - ("\t" x ($indent / 2)) . "$_[1]\n\n" + $pom } -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; @@ -258,7 +300,7 @@ $w = undef; } ); - $entry->focus_in; + $entry->grab_focus; $w->show; } @@ -266,6 +308,9 @@ sub update_widgets { my ($self) = @_; + # necessary to avoid cyclic references + Scalar::Util::weaken $self; + my $button_cb = sub { my (undef, $ev, $x, $y) = @_; @@ -290,6 +335,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 @@ -367,154 +418,6 @@ ); } -package CFClient::Binder; - -my @ALLOWED_MODIFIER_KEYS = ( - CFClient::SDLK_LSHIFT, - CFClient::SDLK_LCTRL , - CFClient::SDLK_LALT , - CFClient::SDLK_LMETA , - - CFClient::SDLK_RSHIFT, - CFClient::SDLK_RCTRL , - CFClient::SDLK_RALT , - CFClient::SDLK_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 calls the $cb with $mod and $sym as args. -sub open_binding_dialog { - my ($cb) = @_; - - my $w = new CFClient::UI::FancyFrame - title => "Bind Action", - x => "center", - y => "center"; - - $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; - - $cb->($mod, $sym); - - $w->destroy - }); - - $entry->focus_in; - $w->show; -} - -sub keycombo_to_name { - my ($mod, $sym) = @_; - - my $mods = join '+', - map { $ALLOWED_MODIFIERS{$_} } - grep { ($_ + 0) & ($mod + 0) } - keys %ALLOWED_MODIFIERS; - $mods .= "+" if $mods ne ''; - - return $mods . CFClient::SDL_GetKeyName ($sym); -} - -package CFClient::Pickup; -# some pickup constants -sub PU_NOTHING { 0x00000000 } - -sub PU_DEBUG { 0x10000000 } -sub PU_INHIBIT { 0x20000000 } -sub PU_STOP { 0x40000000 } -sub PU_NEWMODE { 0x80000000 } - -sub PU_RATIO { 0x0000000F } - -sub PU_FOOD { 0x00000010 } -sub PU_DRINK { 0x00000020 } -sub PU_VALUABLES { 0x00000040 } -sub PU_BOW { 0x00000080 } - -sub PU_ARROW { 0x00000100 } -sub PU_HELMET { 0x00000200 } -sub PU_SHIELD { 0x00000400 } -sub PU_ARMOUR { 0x00000800 } - -sub PU_BOOTS { 0x00001000 } -sub PU_GLOVES { 0x00002000 } -sub PU_CLOAK { 0x00004000 } -sub PU_KEY { 0x00008000 } - -sub PU_MISSILEWEAPON { 0x00010000 } -sub PU_ALLWEAPON { 0x00020000 } -sub PU_MAGICAL { 0x00040000 } -sub PU_POTION { 0x00080000 } - -sub PU_SPELLBOOK { 0x00100000 } -sub PU_SKILLSCROLL { 0x00200000 } -sub PU_READABLES { 0x00400000 } -sub PU_MAGIC_DEVICE { 0x00800000 } - -sub PU_NOT_CURSED { 0x01000000 } - -sub PU_JEWELS { 0x02000000 } - - 1; =back