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.118 by root, Wed Dec 5 11:39:26 2007 UTC vs.
Revision 1.120 by root, Wed Dec 26 18:26:15 2007 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.13'; 9our $VERSION = '1.14';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
24 editor_archs arch_extents 24 editor_archs arch_extents
25); 25);
26 26
27use JSON::XS qw(decode_json encode_json); 27use JSON::XS qw(decode_json encode_json);
28 28
29our $LIB = $ENV{CROSSFIRE_LIBDIR}; 29our $LIB = $ENV{DELIANTRA_LIBDIR} || $ENV{CROSSFIRE_LIBDIR};
30 30
31our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" 31our $OLDDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
32 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" 32 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
33 : File::Spec->tmpdir . "/crossfire"; 33 : File::Spec->tmpdir . "/crossfire";
34
35our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.deliantra"
36 : $ENV{AppData} ? "$ENV{APPDATA}/deliantra"
37 : File::Spec->tmpdir . "/deliantra";
34 38
35mkdir $VARDIR, 0777; 39mkdir $VARDIR, 0777;
36 40
37sub TILESIZE (){ 32 } 41sub TILESIZE (){ 32 }
38sub CACHESTRIDE (){ 64 } 42sub CACHESTRIDE (){ 64 }
… …
154); 158);
155 159
156our @MOVE_TYPE = keys %MOVE_TYPE; 160our @MOVE_TYPE = keys %MOVE_TYPE;
157 161
158{ 162{
159 package Crossfire::MoveType; 163 package Deliantra::MoveType;
160 164
161 use overload 165 use overload
162 '=' => sub { bless [@{$_[0]}], ref $_[0] }, 166 '=' => sub { bless [@{$_[0]}], ref $_[0] },
163 '""' => \&as_string, 167 '""' => \&as_string,
164 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, 168 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
… …
184 'eq' => sub { "$_[0]" eq "$_[1]" }, 188 'eq' => sub { "$_[0]" eq "$_[1]" },
185 'ne' => sub { "$_[0]" ne "$_[1]" }, 189 'ne' => sub { "$_[0]" ne "$_[1]" },
186 ; 190 ;
187} 191}
188 192
189sub Crossfire::MoveType::new { 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"}) {
… …
484} 488}
485 489
486sub attr_freeze($) { 490sub attr_freeze($) {
487 my ($ob) = @_; 491 my ($ob) = @_;
488 492
489 $ob->{attach} = Crossfire::encode_json $ob->{attach} 493 $ob->{attach} = Deliantra::encode_json $ob->{attach}
490 if exists $ob->{attach}; 494 if exists $ob->{attach};
491 495
492 $ob 496 $ob
493} 497}
494 498
… …
624 my $str; 628 my $str;
625 629
626 my $append; $append = sub { 630 my $append; $append = sub {
627 my %a = %{$_[0]}; 631 my %a = %{$_[0]};
628 632
629 Crossfire::attr_freeze \%a; 633 Deliantra::attr_freeze \%a;
630 Crossfire::normalize_arch \%a; 634 Deliantra::normalize_arch \%a;
631 635
632 # undo the bit-split we did before 636 # undo the bit-split we did before
633 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) { 637 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}) 638 $a{attack_movement} = (delete $a{attack_movement_bits_0_3})
635 | (delete $a{attack_movement_bits_4_7}); 639 | (delete $a{attack_movement_bits_4_7});
… …
653 } 657 }
654 658
655 my @kv; 659 my @kv;
656 660
657 for ($a{_name} eq "map" 661 for ($a{_name} eq "map"
658 ? @Crossfire::FIELD_ORDER_MAP 662 ? @Deliantra::FIELD_ORDER_MAP
659 : @Crossfire::FIELD_ORDER) { 663 : @Deliantra::FIELD_ORDER) {
660 push @kv, [$_, delete $a{$_}] 664 push @kv, [$_, delete $a{$_}]
661 if exists $a{$_}; 665 if exists $a{$_};
662 } 666 }
663 667
664 for (sort keys %a) { 668 for (sort keys %a) {
… …
667 } 671 }
668 672
669 for (@kv) { 673 for (@kv) {
670 my ($k, $v) = @$_; 674 my ($k, $v) = @$_;
671 675
672 if (my $end = $Crossfire::FIELD_MULTILINE{$k}) { 676 if (my $end = $Deliantra::FIELD_MULTILINE{$k}) {
673 $v =~ s/\n$//; 677 $v =~ s/\n$//;
674 $str .= "$k\n$v\n$end\n"; 678 $str .= "$k\n$v\n$end\n";
675 } else { 679 } else {
676 $str .= "$k $v\n"; 680 $str .= "$k $v\n";
677 } 681 }
… …
773=cut 777=cut
774 778
775sub arch_attr($) { 779sub arch_attr($) {
776 my ($obj) = @_; 780 my ($obj) = @_;
777 781
778 require Crossfire::Data; 782 require Deliantra::Data;
779 783
780 my $root; 784 my $root;
781 my $attr = { }; 785 my $attr = { };
782 786
783 my $arch = $ARCH{ $obj->{_name} }; 787 my $arch = $ARCH{ $obj->{_name} };
784 my $type = $obj->{type} || $arch->{type}; 788 my $type = $obj->{type} || $arch->{type};
785 789
786 if ($type > 0) { 790 if ($type > 0) {
787 $root = $Crossfire::Data::ATTR{$type}; 791 $root = $Deliantra::Data::ATTR{$type};
788 } else { 792 } else {
789 my %a = (%$arch, %$obj); 793 my %a = (%$arch, %$obj);
790 794
791 if ($a{is_floor} && !$a{alive}) { 795 if ($a{is_floor} && !$a{alive}) {
792 $root = $Crossfire::Data::TYPE{Floor}; 796 $root = $Deliantra::Data::TYPE{Floor};
793 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) { 797 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) {
794 $root = $Crossfire::Data::TYPE{"Monster & NPC"}; 798 $root = $Deliantra::Data::TYPE{"Monster & NPC"};
795 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) { 799 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) {
796 $root = $Crossfire::Data::TYPE{Wall}; 800 $root = $Deliantra::Data::TYPE{Wall};
797 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) { 801 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) {
798 $root = $Crossfire::Data::TYPE{"Weak Wall"}; 802 $root = $Deliantra::Data::TYPE{"Weak Wall"};
799 } else { 803 } else {
800 $root = $Crossfire::Data::TYPE{Misc}; 804 $root = $Deliantra::Data::TYPE{Misc};
801 } 805 }
802 } 806 }
803 807
804 my @import = ($root); 808 my @import = ($root);
805 809
806 unshift @import, \%Crossfire::Data::DEFAULT_ATTR 810 unshift @import, \%Deliantra::Data::DEFAULT_ATTR
807 unless $type == 116; 811 unless $type == 116;
808 812
809 my (%ignore); 813 my (%ignore);
810 my (@section_order, %section, @attr_order); 814 my (@section_order, %section, @attr_order);
811 815
812 while (my $type = shift @import) { 816 while (my $type = shift @import) {
813 push @import, 817 push @import,
814 grep $_, 818 grep $_,
815 map $Crossfire::Data::TYPE{$_}, 819 map $Deliantra::Data::TYPE{$_},
816 @{$type->{import} || []}; 820 @{$type->{import} || []};
817 821
818 $attr->{$_} ||= $type->{$_} 822 $attr->{$_} ||= $type->{$_}
819 for qw(name desc use); 823 for qw(name desc use);
820 824

Diff Legend

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