--- deliantra/Deliantra-Client/DC.pm 2006/04/24 10:19:39 1.46 +++ deliantra/Deliantra-Client/DC.pm 2006/06/07 06:28:28 1.91 @@ -21,33 +21,97 @@ XSLoader::load "CFClient", $VERSION; } +use utf8; + use Carp (); -use AnyEvent; +use AnyEvent (); use BerkeleyDB; -use CFClient::OpenGL; +use Pod::POM (); +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]) }; -our %GL_EXT; -our $GL_VERSION; +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]) +} -our $GL_NPOT; +sub view_verbatim { + (join "", + map +("\t" x ($indent / 2)) . "$_\n", + split /\n/, CFClient::UI::Label::escape ($_[1])) + . "\n" +} -sub gl_init { - $GL_VERSION = gl_version * 1; - %GL_EXT = map +($_ => 1), split /\s+/, gl_extensions; +sub view_textblock { + ("\t" x ($indent / 2)) . "$_[1]\n\n" +} - $GL_NPOT = $GL_EXT{GL_ARB_texture_non_power_of_two} || $GL_VERSION >= 2; +sub view_head1 { + "\n\n" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; - glEnable GL_TEXTURE_2D; - glEnable GL_COLOR_MATERIAL; - glShadeModel GL_FLAT; - glDisable GL_DEPTH_TEST; - glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; +sub view_head2 { + "\n" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; - glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_FASTEST; +sub view_head3 { + "\n" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; - CFClient::Texture::restore_state (); +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; @@ -91,246 +155,360 @@ close CFG; } -mkdir "$Crossfire::VARDIR/pclient", 0777; +our $DB_ENV; + +{ + use strict; -our $DB_ENV = new BerkeleyDB::Env - -Home => "$Crossfire::VARDIR/pclient", - -Cachesize => 1_000_000, - -ErrFile => "$Crossfire::VARDIR/pclient/errorlog.txt", + 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_FATAL | 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, # -Filename => "database", # -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" } -package CFClient::Database; +my $pod_cache = db_table "pod_cache"; -our @ISA = BerkeleyDB::Btree::; +sub load_pod($$$$) { + my ($path, $filtertype, $filterversion, $filtercb) = @_; -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::Texture; - -use strict; + stat $path + or die "$path: $!"; -use Scalar::Util; + my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9]; -use CFClient::OpenGL; + my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } }; -my %TEXTURES; + return $pom if $chash eq $phash; -sub new { - my ($class, %data) = @_; + my $pod = do { + local $/; + open my $pod, "<:utf8", $_[0] + or die "$_[0]: $!"; + <$pod> + }; - my $self = bless { - internalformat => GL_RGBA, - format => GL_RGBA, - type => GL_UNSIGNED_BYTE, - %data, - }, $class; + #utf8::downgrade $pod; - Scalar::Util::weaken ($TEXTURES{$self+0} = $self); + $pom = $filtercb-> (Pod::POM->new->parse_text ($pod)); - $self->upload; + $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]); - $self + $pom } -sub new_from_image { - my ($class, $image, %arg) = @_; +sub pod_to_pango($) { + my ($pom) = @_; - $class->new (image => $image, %arg) + $pom->present ("CFClient::PodToPango") } -sub new_from_file { - my ($class, $path, %arg) = @_; +sub pod_to_pango_list($) { + my ($pom) = @_; - open my $fh, "<:raw", $path - or die "$path: $!"; - - local $/; - $class->new_from_image (<$fh>, %arg) + [ + map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "], + split /\n/, $pom->present ("CFClient::PodToPango") + ] } -#sub new_from_surface { -# my ($class, $surface) = @_; -# -# $surface->rgba; -# -# $class->new ( -# data => $surface->pixels, -# w => $surface->width, -# h => $surface->height, -# ) -#} - -sub new_from_layout { - my ($class, $layout, %arg) = @_; +package CFClient::Item; - my ($w, $h, $data) = $layout->render; +use strict; +use Crossfire::Protocol::Constants; - $class->new ( - w => $w, - h => $h, - data => $data, - format => GL_ALPHA, - internalformat => GL_ALPHA, - type => GL_UNSIGNED_BYTE, - %arg, - ) -} +my $last_enter_count = 1; -sub new_from_opengl { - my ($class, $w, $h, $cb) = @_; +sub desc_string { + my ($self) = @_; - $class->new (w => $w, h => $h, render_cb => $cb) -} + 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 $GL_VERSION; - - my $data; - - if (exists $self->{data}) { - $data = $self->{data}; - - } elsif (exists $self->{render_cb}) { - glViewport 0, 0, $self->{w}, $self->{h}; - glMatrixMode GL_PROJECTION; - glLoadIdentity; - glOrtho 0, $self->{w}, 0, $self->{h}, -10000, 10000; - glMatrixMode GL_MODELVIEW; - glLoadIdentity; - $self->{render_cb}->($self, $self->{w}, $self->{h}); - - } else { - ($self->{w}, $self->{h}, $data, $self->{internalformat}, $self->{format}, $self->{type}) - = CFClient::load_image_inline $self->{image}; - } - - my ($tw, $th) = @$self{qw(w h)}; + my $weight = ($self->{nrof} || 1) * $self->{weight}; - unless ($tw && $th) { - $tw = $th = 1; - $data = "\x00" x 64; - } + $weight < 0 ? "?" : $weight * 0.001 +} - $self->{minified} = [CFClient::average $tw, $th, $data] - if $self->{minify}; +sub do_n_dialog { + my ($cb) = @_; - unless ($GL_NPOT) { - # TODO: does not work for zero-sized textures - $tw = topot $tw; - $th = topot $th; - - if (($tw != $self->{w} || $th != $self->{h}) && defined $data) { - my $bpp = (length $data) / ($self->{w} * $self->{h}); - $data = pack "(a" . ($tw * $bpp) . ")*", - unpack "(a" . ($self->{w} * $bpp) . ")*", $data; - $data .= ("\x00" x ($tw * $bpp)) x ($th - $self->{h}); + 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->focus_in; + $w->show; - $self->{s} = $self->{w} / $tw; - $self->{t} = $self->{h} / $th; +} - $self->{name} ||= glGenTexture; +sub update_widgets { + my ($self) = @_; - glBindTexture GL_TEXTURE_2D, $self->{name}; + my $button_cb = sub { + my (undef, $ev, $x, $y) = @_; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP; - - if ($::FAST) { - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST; - } elsif ($self->{mipmap} && $GL_VERSION >= 1.4) { - # alternatively check for 0x8191 - glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, 1; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR; - } else { - glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, $self->{mipmap}; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR; - glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR; - } - - glGetError; + my $targ = $::CONN->{player}{tag}; - if (defined $data) { - glTexImage2D GL_TEXTURE_2D, 0, - $self->{internalformat}, - $tw, $th, # need to pad texture first - 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}; + if ($self->{container} == $::CONN->{player}{tag}) { + $targ = $::CONN->{open_container}; } - } 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}; + + 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}) }], + ["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); } - } -} -sub DESTROY { - my ($self) = @_; + 1 + }; - delete $TEXTURES{$self+0}; + 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" + ); +} + +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 ''; - glDeleteTexture delete $self->{name} - if $self->{name}; + return $mods . CFClient::SDL_GetKeyName ($sym); } -sub restore_state{ - $_->upload - for values %TEXTURES; -}; - 1; =back