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.115 by root, Sun Sep 16 19:15:34 2007 UTC vs.
Revision 1.135 by root, Tue Nov 3 14:56:58 2009 UTC

1=head1 NAME 1=head1 NAME
2 2
3Crossfire - Crossfire maphandling 3Deliantra - Deliantra suppport module to read/write archetypes, maps etc.
4
5=over 4
4 6
5=cut 7=cut
6 8
7package Crossfire; 9package Deliantra;
8 10
9our $VERSION = '1.1'; 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;
… …
22 *ARCH $TILE *FACE *FACEDATA 24 *ARCH $TILE *FACE *FACEDATA
23 TILESIZE CACHESTRIDE 25 TILESIZE CACHESTRIDE
24 editor_archs arch_extents 26 editor_archs arch_extents
25); 27);
26 28
27use JSON::XS qw(from_json to_json); 29use JSON::XS qw(decode_json encode_json);
28 30
29our $LIB = $ENV{CROSSFIRE_LIBDIR}; 31our $LIB = $ENV{DELIANTRA_LIBDIR};
30 32
31our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" 33our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.deliantra"
32 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" 34 : $ENV{AppData} ? "$ENV{APPDATA}/deliantra"
33 : File::Spec->tmpdir . "/crossfire"; 35 : File::Spec->tmpdir . "/deliantra";
34 36
35mkdir $VARDIR, 0777; 37mkdir $VARDIR, 0777;
36 38
37sub TILESIZE (){ 32 } 39sub TILESIZE (){ 32 }
38sub CACHESTRIDE (){ 64 } 40sub CACHESTRIDE (){ 64 }
… …
69 71
70 elevation 72 elevation
71 73
72 name name_pl custom_name attach title race 74 name name_pl custom_name attach title race
73 slaying skill msg lore other_arch 75 slaying skill msg lore other_arch
74 face animation is_animated 76 sound sound_destroy face animation is_animated
75 magicmap smoothlevel smoothface 77 magicmap smoothlevel smoothface
76 str dex con wis pow cha int 78 str dex con wis pow cha int
77 hp maxhp sp maxsp grace maxgrace 79 hp maxhp sp maxsp grace maxgrace
78 exp perm_exp expmul 80 exp perm_exp expmul
79 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
… …
151 boat => MOVE_BOAT, 153 boat => MOVE_BOAT,
152 ship => MOVE_SHIP, 154 ship => MOVE_SHIP,
153 all => MOVE_ALL, 155 all => MOVE_ALL,
154); 156);
155 157
156our @MOVE_TYPE = keys %MOVE_TYPE; 158our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat ship);
157 159
158{ 160{
159 package Crossfire::MoveType; 161 package Deliantra::MoveType;
160 162
161 use overload 163 use overload
162 '=' => sub { bless [@{$_[0]}], ref $_[0] }, 164 '=' => sub { bless [@{$_[0]}], ref $_[0] },
163 '""' => \&as_string, 165 '""' => \&as_string,
164 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, 166 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
… …
182 $_[0] 184 $_[0]
183 }, 185 },
184 'eq' => sub { "$_[0]" eq "$_[1]" }, 186 'eq' => sub { "$_[0]" eq "$_[1]" },
185 'ne' => sub { "$_[0]" ne "$_[1]" }, 187 'ne' => sub { "$_[0]" ne "$_[1]" },
186 ; 188 ;
187}
188 189
189sub Crossfire::MoveType::new { 190 sub TO_JSON {
191 $_[0][0]
192 }
193}
194
195sub Deliantra::MoveType::new {
190 my ($class, $string) = @_; 196 my ($class, $string) = @_;
191 197
192 my $mask; 198 my $mask;
193 my $value; 199 my $value;
194 200
… …
208 } 214 }
209 215
210 (bless [$mask, $value], $class)->normalise 216 (bless [$mask, $value], $class)->normalise
211} 217}
212 218
213sub Crossfire::MoveType::normalise { 219sub Deliantra::MoveType::normalise {
214 my ($self) = @_; 220 my ($self) = @_;
215 221
216 if ($self->[0] & MOVE_ALL) { 222 if ($self->[0] & MOVE_ALL) {
217 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL); 223 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL);
218 $self->[0] &= $mask; 224 $self->[0] &= $mask;
… …
222 $self->[1] &= $self->[0]; 228 $self->[1] &= $self->[0];
223 229
224 $self 230 $self
225} 231}
226 232
227sub Crossfire::MoveType::as_string { 233sub Deliantra::MoveType::as_string {
228 my ($self) = @_; 234 my ($self) = @_;
229 235
230 my @res; 236 my @res;
231 237
232 my ($mask, $value) = @$self; 238 my ($mask, $value) = @$self;
233 239
234 for (@Crossfire::MOVE_TYPE) { 240 for (@Deliantra::MOVE_TYPE) {
235 my $bit = $Crossfire::MOVE_TYPE{$_}; 241 my $bit = $Deliantra::MOVE_TYPE{$_};
236 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) { 242 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) {
237 $mask &= ~$bit; 243 $mask &= ~$bit;
238 push @res, $value & $bit ? $_ : "-$_"; 244 push @res, $value & $bit ? $_ : "-$_";
239 } 245 }
240 } 246 }
… …
333 339
334# object as in "Object xxx", i.e. archetypes 340# object as in "Object xxx", i.e. archetypes
335sub normalize_object($) { 341sub normalize_object($) {
336 my ($ob) = @_; 342 my ($ob) = @_;
337 343
344 delete $ob->{editable}; # deprecated
345
338 # convert material bitset to materialname, if possible 346 # convert material bitset to materialname, if possible
339 if (exists $ob->{material}) { 347 if (exists $ob->{material}) {
340 if (!$ob->{material}) { 348 if (!$ob->{material}) {
341 delete $ob->{material}; 349 delete $ob->{material};
342 } elsif (exists $ob->{materialname}) { 350 } elsif (exists $ob->{materialname}) {
… …
380 388
381 # convert movement strings to bitsets 389 # convert movement strings to bitsets
382 for my $attr (keys %FIELD_MOVEMENT) { 390 for my $attr (keys %FIELD_MOVEMENT) {
383 next unless exists $ob->{$attr}; 391 next unless exists $ob->{$attr};
384 392
385 $ob->{$attr} = new Crossfire::MoveType $ob->{$attr}; 393 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr};
386 } 394 }
387 395
388 # convert outdated movement flags to new movement sets 396 # convert outdated movement flags to new movement sets
389 if (defined (my $v = delete $ob->{no_pass})) { 397 if (defined (my $v = delete $ob->{no_pass})) {
390 $ob->{move_block} = new Crossfire::MoveType $v ? "all" : ""; 398 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : "0";
391 } 399 }
392 if (defined (my $v = delete $ob->{slow_move})) { 400 if (defined (my $v = delete $ob->{slow_move})) {
393 $ob->{move_slow} += "walk"; 401 $ob->{move_slow} += "walk";
394 $ob->{move_slow_penalty} = $v; 402 $ob->{move_slow_penalty} = $v;
395 } 403 }
396 if (defined (my $v = delete $ob->{walk_on})) { 404 if (defined (my $v = delete $ob->{walk_on})) {
397 $ob->{move_on} ||= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" } 405 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
398 } 406 }
399 if (defined (my $v = delete $ob->{walk_off})) { 407 if (defined (my $v = delete $ob->{walk_off})) {
400 $ob->{move_off} ||= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" } 408 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
401 } 409 }
402 if (defined (my $v = delete $ob->{fly_on})) { 410 if (defined (my $v = delete $ob->{fly_on})) {
403 $ob->{move_on} ||= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" } 411 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" }
404 } 412 }
405 if (defined (my $v = delete $ob->{fly_off})) { 413 if (defined (my $v = delete $ob->{fly_off})) {
406 $ob->{move_off} ||= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" } 414 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" }
407 } 415 }
408 if (defined (my $v = delete $ob->{flying})) { 416 if (defined (my $v = delete $ob->{flying})) {
409 $ob->{move_type} ||= new Crossfire::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" } 417 $ob->{move_type} ||= new Deliantra::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" }
410 } 418 }
411 419
412 # convert idiotic event_xxx things into objects 420 # convert idiotic event_xxx things into objects
413 while (my ($event, $subtype) = each %EVENT_TYPE) { 421 while (my ($event, $subtype) = each %EVENT_TYPE) {
414 if (exists $ob->{"event_${event}_plugin"}) { 422 if (exists $ob->{"event_${event}_plugin"}) {
… …
430# arch as in "arch xxx", ie.. objects 438# arch as in "arch xxx", ie.. objects
431sub normalize_arch($) { 439sub normalize_arch($) {
432 my ($ob) = @_; 440 my ($ob) = @_;
433 441
434 normalize_object $ob; 442 normalize_object $ob;
443
444 return if $ob->{_atype} eq "object";
435 445
436 my $arch = $ARCH{$ob->{_name}} 446 my $arch = $ARCH{$ob->{_name}}
437 or (warn "$ob->{_name}: no such archetype", return $ob); 447 or (warn "$ob->{_name}: no such archetype", return $ob);
438 448
439 if ($arch->{type} == 22) { # map 449 if ($arch->{type} == 22) { # map
… …
475} 485}
476 486
477sub attr_thaw($) { 487sub attr_thaw($) {
478 my ($ob) = @_; 488 my ($ob) = @_;
479 489
480 $ob->{attach} = from_json $ob->{attach} 490 $ob->{attach} = decode_json $ob->{attach}
481 if exists $ob->{attach}; 491 if exists $ob->{attach};
482 492
483 $ob 493 $ob
484} 494}
485 495
486sub attr_freeze($) { 496sub attr_freeze($) {
487 my ($ob) = @_; 497 my ($ob) = @_;
488 498
489 $ob->{attach} = Crossfire::to_json $ob->{attach} 499 $ob->{attach} = JSON::XS->new->utf8->canonical->encode ($ob->{attach})
490 if exists $ob->{attach}; 500 if exists $ob->{attach};
491 501
492 $ob 502 $ob
493} 503}
494 504
… …
514 524
515 my %arc; 525 my %arc;
516 my ($more, $prev); 526 my ($more, $prev);
517 my $comment; 527 my $comment;
518 528
519 open my $fh, "<:raw:perlio:utf8", $path 529 open my $fh, "<:utf8", $path
520 or Carp::croak "$path: $!"; 530 or Carp::croak "$path: $!";
521 531
522# binmode $fh; 532# binmode $fh;
523 533
524 my $parse_block; $parse_block = sub { 534 my $parse_block; $parse_block = sub {
… …
624 my $str; 634 my $str;
625 635
626 my $append; $append = sub { 636 my $append; $append = sub {
627 my %a = %{$_[0]}; 637 my %a = %{$_[0]};
628 638
629 Crossfire::attr_freeze \%a; 639 Deliantra::attr_freeze \%a;
630 Crossfire::normalize_arch \%a; 640 Deliantra::normalize_arch \%a;
631 641
632 # undo the bit-split we did before 642 # undo the bit-split we did before
633 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) { 643 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) {
634 $a{attack_movement} = (delete $a{attack_movement_bits_0_3}) 644 $a{attack_movement} = (delete $a{attack_movement_bits_0_3})
635 | (delete $a{attack_movement_bits_4_7}); 645 | (delete $a{attack_movement_bits_4_7});
… …
653 } 663 }
654 664
655 my @kv; 665 my @kv;
656 666
657 for ($a{_name} eq "map" 667 for ($a{_name} eq "map"
658 ? @Crossfire::FIELD_ORDER_MAP 668 ? @Deliantra::FIELD_ORDER_MAP
659 : @Crossfire::FIELD_ORDER) { 669 : @Deliantra::FIELD_ORDER) {
660 push @kv, [$_, delete $a{$_}] 670 push @kv, [$_, delete $a{$_}]
661 if exists $a{$_}; 671 if exists $a{$_};
662 } 672 }
663 673
664 for (sort keys %a) { 674 for (sort keys %a) {
… …
667 } 677 }
668 678
669 for (@kv) { 679 for (@kv) {
670 my ($k, $v) = @$_; 680 my ($k, $v) = @$_;
671 681
672 if (my $end = $Crossfire::FIELD_MULTILINE{$k}) { 682 if (my $end = $Deliantra::FIELD_MULTILINE{$k}) {
673 $v =~ s/\n$//; 683 $v =~ s/\n$//;
674 $str .= "$k\n$v\n$end\n"; 684 $str .= "$k\n$v\n$end\n";
675 } else { 685 } else {
676 $str .= "$k $v\n"; 686 $str .= "$k $v\n";
677 } 687 }
… …
773=cut 783=cut
774 784
775sub arch_attr($) { 785sub arch_attr($) {
776 my ($obj) = @_; 786 my ($obj) = @_;
777 787
778 require Crossfire::Data; 788 require Deliantra::Data;
779 789
780 my $root; 790 my $root;
781 my $attr = { }; 791 my $attr = { };
782 792
783 my $arch = $ARCH{ $obj->{_name} }; 793 my $arch = $ARCH{ $obj->{_name} };
784 my $type = $obj->{type} || $arch->{type}; 794 my $type = $obj->{type} || $arch->{type};
785 795
786 if ($type > 0) { 796 if ($type > 0) {
787 $root = $Crossfire::Data::ATTR{$type}; 797 $root = $Deliantra::Data::ATTR{$type};
788 } else { 798 } else {
789 my %a = (%$arch, %$obj); 799 my %a = (%$arch, %$obj);
790 800
791 if ($a{is_floor} && !$a{alive}) { 801 if ($a{is_floor} && !$a{alive}) {
792 $root = $Crossfire::Data::TYPE{Floor}; 802 $root = $Deliantra::Data::TYPE{Floor};
793 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) { 803 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) {
794 $root = $Crossfire::Data::TYPE{"Monster & NPC"}; 804 $root = $Deliantra::Data::TYPE{"Monster & NPC"};
795 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) { 805 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) {
796 $root = $Crossfire::Data::TYPE{Wall}; 806 $root = $Deliantra::Data::TYPE{Wall};
797 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) { 807 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) {
798 $root = $Crossfire::Data::TYPE{"Weak Wall"}; 808 $root = $Deliantra::Data::TYPE{"Weak Wall"};
799 } else { 809 } else {
800 $root = $Crossfire::Data::TYPE{Misc}; 810 $root = $Deliantra::Data::TYPE{Misc};
801 } 811 }
802 } 812 }
803 813
804 my @import = ($root); 814 my @import = ($root);
805 815
806 unshift @import, \%Crossfire::Data::DEFAULT_ATTR 816 unshift @import, \%Deliantra::Data::DEFAULT_ATTR
807 unless $type == 116; 817 unless $type == 116;
808 818
809 my (%ignore); 819 my (%ignore);
810 my (@section_order, %section, @attr_order); 820 my (@section_order, %section, @attr_order);
811 821
812 while (my $type = shift @import) { 822 while (my $type = shift @import) {
813 push @import, 823 push @import,
814 grep $_, 824 grep $_,
815 map $Crossfire::Data::TYPE{$_}, 825 map $Deliantra::Data::TYPE{$_},
816 @{$type->{import} || []}; 826 @{$type->{import} || []};
817 827
818 $attr->{$_} ||= $type->{$_} 828 $attr->{$_} ||= $type->{$_}
819 for qw(name desc use); 829 for qw(name desc use);
820 830
… …
981 991
982 \%cache 992 \%cache
983 }; 993 };
984} 994}
985 995
996=back
997
986=head1 AUTHOR 998=head1 AUTHOR
987 999
988 Marc Lehmann <schmorp@schmorp.de> 1000 Marc Lehmann <schmorp@schmorp.de>
989 http://home.schmorp.de/ 1001 http://home.schmorp.de/
990 1002

Diff Legend

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