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.117 by root, Wed Dec 5 11:03:08 2007 UTC vs.
Revision 1.131 by root, Tue Sep 1 21:37:25 2009 UTC

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

Diff Legend

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