ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/Deliantra.pm
(Generate patch)

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.120 by root, Wed Dec 26 18:26:15 2007 UTC vs.
Revision 1.134 by root, Wed Oct 28 10:17:01 2009 UTC

1=head1 NAME 1=head1 NAME
2 2
3Deliantra - Deliantra suppport module to read/write archetypes, maps etc. 3Deliantra - Deliantra suppport module to read/write archetypes, maps etc.
4 4
5=over 4
6
5=cut 7=cut
6 8
7package Deliantra; 9package Deliantra;
8 10
9our $VERSION = '1.14'; 11our $VERSION = '1.25';
10 12
11use strict; 13use common::sense;
12 14
13use base 'Exporter'; 15use base 'Exporter';
14 16
15use Carp (); 17use Carp ();
16use File::Spec; 18use File::Spec;
… …
24 editor_archs arch_extents 26 editor_archs arch_extents
25); 27);
26 28
27use JSON::XS qw(decode_json encode_json); 29use JSON::XS qw(decode_json encode_json);
28 30
29our $LIB = $ENV{DELIANTRA_LIBDIR} || $ENV{CROSSFIRE_LIBDIR}; 31our $LIB = $ENV{DELIANTRA_LIBDIR};
30
31our $OLDDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
32 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
33 : File::Spec->tmpdir . "/crossfire";
34 32
35our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.deliantra" 33our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.deliantra"
36 : $ENV{AppData} ? "$ENV{APPDATA}/deliantra" 34 : $ENV{AppData} ? "$ENV{APPDATA}/deliantra"
37 : File::Spec->tmpdir . "/deliantra"; 35 : File::Spec->tmpdir . "/deliantra";
38 36
… …
73 71
74 elevation 72 elevation
75 73
76 name name_pl custom_name attach title race 74 name name_pl custom_name attach title race
77 slaying skill msg lore other_arch 75 slaying skill msg lore other_arch
78 face animation is_animated 76 sound sound_destroy face animation is_animated
79 magicmap smoothlevel smoothface 77 magicmap smoothlevel smoothface
80 str dex con wis pow cha int 78 str dex con wis pow cha int
81 hp maxhp sp maxsp grace maxgrace 79 hp maxhp sp maxsp grace maxgrace
82 exp perm_exp expmul 80 exp perm_exp expmul
83 food dam luck wc ac x y speed speed_left move_state attack_movement 81 food dam luck wc ac x y speed speed_left move_state attack_movement
… …
155 boat => MOVE_BOAT, 153 boat => MOVE_BOAT,
156 ship => MOVE_SHIP, 154 ship => MOVE_SHIP,
157 all => MOVE_ALL, 155 all => MOVE_ALL,
158); 156);
159 157
160our @MOVE_TYPE = keys %MOVE_TYPE; 158our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat ship);
161 159
162{ 160{
163 package Deliantra::MoveType; 161 package Deliantra::MoveType;
164 162
165 use overload 163 use overload
… …
186 $_[0] 184 $_[0]
187 }, 185 },
188 'eq' => sub { "$_[0]" eq "$_[1]" }, 186 'eq' => sub { "$_[0]" eq "$_[1]" },
189 'ne' => sub { "$_[0]" ne "$_[1]" }, 187 'ne' => sub { "$_[0]" ne "$_[1]" },
190 ; 188 ;
189
190 sub TO_JSON {
191 $_[0][0]
192 }
191} 193}
192 194
193sub Deliantra::MoveType::new { 195sub Deliantra::MoveType::new {
194 my ($class, $string) = @_; 196 my ($class, $string) = @_;
195 197
… …
389 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr}; 391 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr};
390 } 392 }
391 393
392 # convert outdated movement flags to new movement sets 394 # convert outdated movement flags to new movement sets
393 if (defined (my $v = delete $ob->{no_pass})) { 395 if (defined (my $v = delete $ob->{no_pass})) {
394 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : ""; 396 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : "0";
395 } 397 }
396 if (defined (my $v = delete $ob->{slow_move})) { 398 if (defined (my $v = delete $ob->{slow_move})) {
397 $ob->{move_slow} += "walk"; 399 $ob->{move_slow} += "walk";
398 $ob->{move_slow_penalty} = $v; 400 $ob->{move_slow_penalty} = $v;
399 } 401 }
400 if (defined (my $v = delete $ob->{walk_on})) { 402 if (defined (my $v = delete $ob->{walk_on})) {
401 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" } 403 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
402 } 404 }
403 if (defined (my $v = delete $ob->{walk_off})) { 405 if (defined (my $v = delete $ob->{walk_off})) {
404 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" } 406 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
405 } 407 }
406 if (defined (my $v = delete $ob->{fly_on})) { 408 if (defined (my $v = delete $ob->{fly_on})) {
… …
434# arch as in "arch xxx", ie.. objects 436# arch as in "arch xxx", ie.. objects
435sub normalize_arch($) { 437sub normalize_arch($) {
436 my ($ob) = @_; 438 my ($ob) = @_;
437 439
438 normalize_object $ob; 440 normalize_object $ob;
441
442 return if $ob->{_atype} eq "object";
439 443
440 my $arch = $ARCH{$ob->{_name}} 444 my $arch = $ARCH{$ob->{_name}}
441 or (warn "$ob->{_name}: no such archetype", return $ob); 445 or (warn "$ob->{_name}: no such archetype", return $ob);
442 446
443 if ($arch->{type} == 22) { # map 447 if ($arch->{type} == 22) { # map
… …
488} 492}
489 493
490sub attr_freeze($) { 494sub attr_freeze($) {
491 my ($ob) = @_; 495 my ($ob) = @_;
492 496
493 $ob->{attach} = Deliantra::encode_json $ob->{attach} 497 $ob->{attach} = JSON::XS->new->utf8->canonical->encode ($ob->{attach})
494 if exists $ob->{attach}; 498 if exists $ob->{attach};
495 499
496 $ob 500 $ob
497} 501}
498 502
… …
518 522
519 my %arc; 523 my %arc;
520 my ($more, $prev); 524 my ($more, $prev);
521 my $comment; 525 my $comment;
522 526
523 open my $fh, "<:raw:perlio:utf8", $path 527 open my $fh, "<:utf8", $path
524 or Carp::croak "$path: $!"; 528 or Carp::croak "$path: $!";
525 529
526# binmode $fh; 530# binmode $fh;
527 531
528 my $parse_block; $parse_block = sub { 532 my $parse_block; $parse_block = sub {
… …
985 989
986 \%cache 990 \%cache
987 }; 991 };
988} 992}
989 993
994=back
995
990=head1 AUTHOR 996=head1 AUTHOR
991 997
992 Marc Lehmann <schmorp@schmorp.de> 998 Marc Lehmann <schmorp@schmorp.de>
993 http://home.schmorp.de/ 999 http://home.schmorp.de/
994 1000

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines