--- deliantra/Deliantra/Deliantra.pm 2007/12/26 18:26:15 1.120 +++ deliantra/Deliantra/Deliantra.pm 2011/12/31 03:46:50 1.144 @@ -2,13 +2,15 @@ Deliantra - Deliantra suppport module to read/write archetypes, maps etc. +=over 4 + =cut package Deliantra; -our $VERSION = '1.14'; +our $VERSION = '1.31'; -use strict; +use common::sense; use base 'Exporter'; @@ -26,11 +28,7 @@ use JSON::XS qw(decode_json encode_json); -our $LIB = $ENV{DELIANTRA_LIBDIR} || $ENV{CROSSFIRE_LIBDIR}; - -our $OLDDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" - : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" - : File::Spec->tmpdir . "/crossfire"; +our $LIB = $ENV{DELIANTRA_LIBDIR}; our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.deliantra" : $ENV{AppData} ? "$ENV{APPDATA}/deliantra" @@ -60,7 +58,8 @@ # to the other editors. our @FIELD_ORDER_MAP = (qw( file_format_version - name attach swap_time reset_timeout fixed_resettime difficulty region + name attach swap_time reset_timeout fixed_resettime difficulty + region music shopitems shopgreed shopmin shopmax shoprace darkness width height enter_x enter_y msg maplore unique template @@ -75,8 +74,8 @@ name name_pl custom_name attach title race slaying skill msg lore other_arch - face animation is_animated - magicmap smoothlevel smoothface + sound sound_destroy face animation is_animated + magicmap glyph smoothlevel smoothface str dex con wis pow cha int hp maxhp sp maxsp grace maxgrace exp perm_exp expmul @@ -136,6 +135,26 @@ timer => 12, ); +# 1 up 2 right 4 down 8 left +our %WALLDIR = ( + 0 => 0, + 1_2 => 1, + 1_4 => 2, + 2_2_1 => 3, + 1_1 => 4, + 2_1_1 => 5, + 2_2_2 => 6, + 3_2 => 7, + 1_3 => 8, + 2_2_4 => 9, + 2_1_2 => 10, + 3_1 => 11, + 2_2_3 => 12, + 3_4 => 13, + 3_3 => 14, + 4 => 15, +); + sub MOVE_WALK (){ 0x01 } sub MOVE_FLY_LOW (){ 0x02 } sub MOVE_FLY_HIGH (){ 0x04 } @@ -157,7 +176,7 @@ all => MOVE_ALL, ); -our @MOVE_TYPE = keys %MOVE_TYPE; +our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat ship); { package Deliantra::MoveType; @@ -166,10 +185,15 @@ '=' => sub { bless [@{$_[0]}], ref $_[0] }, '""' => \&as_string, '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, + '<=' => sub { + ($_[0][0] & $MOVE_TYPE{$_[1]}) == $MOVE_TYPE{$_[1]} + ? $_[0][1] & $MOVE_TYPE{$_[1]} + : undef + }, '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise }, '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise }, '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise }, - 'x=' => sub { + 'x=' => sub { # toggle between off, + and - my $cur = $_[0] >= $_[1]; if (!defined $cur) { if ($_[0] >= "all") { @@ -188,6 +212,10 @@ 'eq' => sub { "$_[0]" eq "$_[1]" }, 'ne' => sub { "$_[0]" ne "$_[1]" }, ; + + sub TO_JSON { + $_[0][0] + } } sub Deliantra::MoveType::new { @@ -339,6 +367,8 @@ sub normalize_object($) { my ($ob) = @_; + delete $ob->{editable}; # deprecated + # convert material bitset to materialname, if possible if (exists $ob->{material}) { if (!$ob->{material}) { @@ -391,14 +421,14 @@ # convert outdated movement flags to new movement sets if (defined (my $v = delete $ob->{no_pass})) { - $ob->{move_block} = new Deliantra::MoveType $v ? "all" : ""; + $ob->{move_block} = new Deliantra::MoveType $v ? "all" : "0"; } if (defined (my $v = delete $ob->{slow_move})) { $ob->{move_slow} += "walk"; $ob->{move_slow_penalty} = $v; } if (defined (my $v = delete $ob->{walk_on})) { - $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" } + $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" } } if (defined (my $v = delete $ob->{walk_off})) { $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" } @@ -437,6 +467,8 @@ normalize_object $ob; + return if $ob->{_atype} eq "object"; + my $arch = $ARCH{$ob->{_name}} or (warn "$ob->{_name}: no such archetype", return $ob); @@ -490,7 +522,7 @@ sub attr_freeze($) { my ($ob) = @_; - $ob->{attach} = Deliantra::encode_json $ob->{attach} + $ob->{attach} = JSON::XS->new->utf8->canonical->encode ($ob->{attach}) if exists $ob->{attach}; $ob @@ -520,7 +552,7 @@ my ($more, $prev); my $comment; - open my $fh, "<:raw:perlio:utf8", $path + open my $fh, "<:utf8", $path or Carp::croak "$path: $!"; # binmode $fh; @@ -805,38 +837,64 @@ } } - my @import = ($root); - - unshift @import, \%Deliantra::Data::DEFAULT_ATTR - unless $type == 116; - my (%ignore); - my (@section_order, %section, @attr_order); + my @import = ($root); + my @new_import; while (my $type = shift @import) { + # first import everything we will need: push @import, grep $_, map $Deliantra::Data::TYPE{$_}, @{$type->{import} || []}; - $attr->{$_} ||= $type->{$_} - for qw(name desc use); - + # and compute the ignored attributes for (@{$type->{ignore} || []}) { $ignore{$_}++ for ref $_ ? @$_ : $_; } + push @new_import, $type; + } + (@import) = @new_import; + + # then add defaults to the back of the list, so they are added + # as last resort. + push @import, \%Deliantra::Data::DEFAULT_ATTR + unless $type == 116; + + my (@section_order, %section, @attr_order); + + # @import = root, imported, default + while (my $type = pop @import) { + $attr->{$_} ||= $type->{$_} + for qw(name desc use); + for ([general => ($type->{attr} || [])], @{$type->{section} || []}) { my ($name, $attr) = @$_; push @section_order, $name; for (@$attr) { my ($k, $v) = @$_; push @attr_order, $k; - $section{$name}{$k} ||= $v; + $section{$name}{$k} = $v; # overwrite, so that the root decides } } } + # remove ignores for "root" type + for ( + map @{$_->[1]}, # section attributes + [general => ($root->{attr} || [])], + @{$root->{section} || []} + ) { + my ($k, $v) = @$_; + # skip fixed attributes, if they are ignored thats fine + next if $v->{type} eq 'fixed'; + + delete $ignore{$k}; # if the attributes are defined explicitly they + # should NOT be ignored. ignore should mainly + # hit imported/inherited attributes. + } + $attr->{section} = [ map !exists $section{$_} ? () : do { my $attr = delete $section{$_}; @@ -848,8 +906,7 @@ @attr_order ] }, - - exists $section{$_} ? [$_ => delete $section{$_}] : (), + exists $section{$_} ? [$_ => delete $section{$_}] : (), @section_order ]; @@ -987,6 +1044,8 @@ }; } +=back + =head1 AUTHOR Marc Lehmann