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.114 by root, Sun Sep 16 13:28:41 2007 UTC vs.
Revision 1.129 by root, Sun Jan 11 22:03:03 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.0'; 9our $VERSION = '1.23';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
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
… …
154); 154);
155 155
156our @MOVE_TYPE = keys %MOVE_TYPE; 156our @MOVE_TYPE = keys %MOVE_TYPE;
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 },
… …
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} 187}
188 188
189sub Crossfire::MoveType::new { 189sub Deliantra::MoveType::new {
190 my ($class, $string) = @_; 190 my ($class, $string) = @_;
191 191
192 my $mask; 192 my $mask;
193 my $value; 193 my $value;
194 194
… …
208 } 208 }
209 209
210 (bless [$mask, $value], $class)->normalise 210 (bless [$mask, $value], $class)->normalise
211} 211}
212 212
213sub Crossfire::MoveType::normalise { 213sub Deliantra::MoveType::normalise {
214 my ($self) = @_; 214 my ($self) = @_;
215 215
216 if ($self->[0] & MOVE_ALL) { 216 if ($self->[0] & MOVE_ALL) {
217 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL); 217 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL);
218 $self->[0] &= $mask; 218 $self->[0] &= $mask;
… …
222 $self->[1] &= $self->[0]; 222 $self->[1] &= $self->[0];
223 223
224 $self 224 $self
225} 225}
226 226
227sub Crossfire::MoveType::as_string { 227sub Deliantra::MoveType::as_string {
228 my ($self) = @_; 228 my ($self) = @_;
229 229
230 my @res; 230 my @res;
231 231
232 my ($mask, $value) = @$self; 232 my ($mask, $value) = @$self;
233 233
234 for (@Crossfire::MOVE_TYPE) { 234 for (@Deliantra::MOVE_TYPE) {
235 my $bit = $Crossfire::MOVE_TYPE{$_}; 235 my $bit = $Deliantra::MOVE_TYPE{$_};
236 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) { 236 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) {
237 $mask &= ~$bit; 237 $mask &= ~$bit;
238 push @res, $value & $bit ? $_ : "-$_"; 238 push @res, $value & $bit ? $_ : "-$_";
239 } 239 }
240 } 240 }
… …
380 380
381 # convert movement strings to bitsets 381 # convert movement strings to bitsets
382 for my $attr (keys %FIELD_MOVEMENT) { 382 for my $attr (keys %FIELD_MOVEMENT) {
383 next unless exists $ob->{$attr}; 383 next unless exists $ob->{$attr};
384 384
385 $ob->{$attr} = new Crossfire::MoveType $ob->{$attr}; 385 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr};
386 } 386 }
387 387
388 # convert outdated movement flags to new movement sets 388 # convert outdated movement flags to new movement sets
389 if (defined (my $v = delete $ob->{no_pass})) { 389 if (defined (my $v = delete $ob->{no_pass})) {
390 $ob->{move_block} = new Crossfire::MoveType $v ? "all" : ""; 390 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : "";
391 } 391 }
392 if (defined (my $v = delete $ob->{slow_move})) { 392 if (defined (my $v = delete $ob->{slow_move})) {
393 $ob->{move_slow} += "walk"; 393 $ob->{move_slow} += "walk";
394 $ob->{move_slow_penalty} = $v; 394 $ob->{move_slow_penalty} = $v;
395 } 395 }
396 if (defined (my $v = delete $ob->{walk_on})) { 396 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" } 397 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
398 } 398 }
399 if (defined (my $v = delete $ob->{walk_off})) { 399 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" } 400 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
401 } 401 }
402 if (defined (my $v = delete $ob->{fly_on})) { 402 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" } 403 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" }
404 } 404 }
405 if (defined (my $v = delete $ob->{fly_off})) { 405 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" } 406 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" }
407 } 407 }
408 if (defined (my $v = delete $ob->{flying})) { 408 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" } 409 $ob->{move_type} ||= new Deliantra::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" }
410 } 410 }
411 411
412 # convert idiotic event_xxx things into objects 412 # convert idiotic event_xxx things into objects
413 while (my ($event, $subtype) = each %EVENT_TYPE) { 413 while (my ($event, $subtype) = each %EVENT_TYPE) {
414 if (exists $ob->{"event_${event}_plugin"}) { 414 if (exists $ob->{"event_${event}_plugin"}) {
… …
430# arch as in "arch xxx", ie.. objects 430# arch as in "arch xxx", ie.. objects
431sub normalize_arch($) { 431sub normalize_arch($) {
432 my ($ob) = @_; 432 my ($ob) = @_;
433 433
434 normalize_object $ob; 434 normalize_object $ob;
435
436 return if $ob->{_atype} eq "object";
435 437
436 my $arch = $ARCH{$ob->{_name}} 438 my $arch = $ARCH{$ob->{_name}}
437 or (warn "$ob->{_name}: no such archetype", return $ob); 439 or (warn "$ob->{_name}: no such archetype", return $ob);
438 440
439 if ($arch->{type} == 22) { # map 441 if ($arch->{type} == 22) { # map
… …
475} 477}
476 478
477sub attr_thaw($) { 479sub attr_thaw($) {
478 my ($ob) = @_; 480 my ($ob) = @_;
479 481
480 $ob->{attach} = from_json $ob->{attach} 482 $ob->{attach} = decode_json $ob->{attach}
481 if exists $ob->{attach}; 483 if exists $ob->{attach};
482 484
483 $ob 485 $ob
484} 486}
485 487
486sub attr_freeze($) { 488sub attr_freeze($) {
487 my ($ob) = @_; 489 my ($ob) = @_;
488 490
489 $ob->{attach} = Crossfire::to_json $ob->{attach} 491 $ob->{attach} = JSON::XS->new->utf8->canonical->encode ($ob->{attach})
490 if exists $ob->{attach}; 492 if exists $ob->{attach};
491 493
492 $ob 494 $ob
493} 495}
494 496
… …
514 516
515 my %arc; 517 my %arc;
516 my ($more, $prev); 518 my ($more, $prev);
517 my $comment; 519 my $comment;
518 520
519 open my $fh, "<:raw:perlio:utf8", $path 521 open my $fh, "<:utf8", $path
520 or Carp::croak "$path: $!"; 522 or Carp::croak "$path: $!";
521 523
522# binmode $fh; 524# binmode $fh;
523 525
524 my $parse_block; $parse_block = sub { 526 my $parse_block; $parse_block = sub {
… …
624 my $str; 626 my $str;
625 627
626 my $append; $append = sub { 628 my $append; $append = sub {
627 my %a = %{$_[0]}; 629 my %a = %{$_[0]};
628 630
629 Crossfire::attr_freeze \%a; 631 Deliantra::attr_freeze \%a;
630 Crossfire::normalize_arch \%a; 632 Deliantra::normalize_arch \%a;
631 633
632 # undo the bit-split we did before 634 # undo the bit-split we did before
633 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) { 635 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}) 636 $a{attack_movement} = (delete $a{attack_movement_bits_0_3})
635 | (delete $a{attack_movement_bits_4_7}); 637 | (delete $a{attack_movement_bits_4_7});
… …
653 } 655 }
654 656
655 my @kv; 657 my @kv;
656 658
657 for ($a{_name} eq "map" 659 for ($a{_name} eq "map"
658 ? @Crossfire::FIELD_ORDER_MAP 660 ? @Deliantra::FIELD_ORDER_MAP
659 : @Crossfire::FIELD_ORDER) { 661 : @Deliantra::FIELD_ORDER) {
660 push @kv, [$_, delete $a{$_}] 662 push @kv, [$_, delete $a{$_}]
661 if exists $a{$_}; 663 if exists $a{$_};
662 } 664 }
663 665
664 for (sort keys %a) { 666 for (sort keys %a) {
… …
667 } 669 }
668 670
669 for (@kv) { 671 for (@kv) {
670 my ($k, $v) = @$_; 672 my ($k, $v) = @$_;
671 673
672 if (my $end = $Crossfire::FIELD_MULTILINE{$k}) { 674 if (my $end = $Deliantra::FIELD_MULTILINE{$k}) {
673 $v =~ s/\n$//; 675 $v =~ s/\n$//;
674 $str .= "$k\n$v\n$end\n"; 676 $str .= "$k\n$v\n$end\n";
675 } else { 677 } else {
676 $str .= "$k $v\n"; 678 $str .= "$k $v\n";
677 } 679 }
… …
773=cut 775=cut
774 776
775sub arch_attr($) { 777sub arch_attr($) {
776 my ($obj) = @_; 778 my ($obj) = @_;
777 779
778 require Crossfire::Data; 780 require Deliantra::Data;
779 781
780 my $root; 782 my $root;
781 my $attr = { }; 783 my $attr = { };
782 784
783 my $arch = $ARCH{ $obj->{_name} }; 785 my $arch = $ARCH{ $obj->{_name} };
784 my $type = $obj->{type} || $arch->{type}; 786 my $type = $obj->{type} || $arch->{type};
785 787
786 if ($type > 0) { 788 if ($type > 0) {
787 $root = $Crossfire::Data::ATTR{$type}; 789 $root = $Deliantra::Data::ATTR{$type};
788 } else { 790 } else {
789 my %a = (%$arch, %$obj); 791 my %a = (%$arch, %$obj);
790 792
791 if ($a{is_floor} && !$a{alive}) { 793 if ($a{is_floor} && !$a{alive}) {
792 $root = $Crossfire::Data::TYPE{Floor}; 794 $root = $Deliantra::Data::TYPE{Floor};
793 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) { 795 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) {
794 $root = $Crossfire::Data::TYPE{"Monster & NPC"}; 796 $root = $Deliantra::Data::TYPE{"Monster & NPC"};
795 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) { 797 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) {
796 $root = $Crossfire::Data::TYPE{Wall}; 798 $root = $Deliantra::Data::TYPE{Wall};
797 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) { 799 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) {
798 $root = $Crossfire::Data::TYPE{"Weak Wall"}; 800 $root = $Deliantra::Data::TYPE{"Weak Wall"};
799 } else { 801 } else {
800 $root = $Crossfire::Data::TYPE{Misc}; 802 $root = $Deliantra::Data::TYPE{Misc};
801 } 803 }
802 } 804 }
803 805
804 my @import = ($root); 806 my @import = ($root);
805 807
806 unshift @import, \%Crossfire::Data::DEFAULT_ATTR 808 unshift @import, \%Deliantra::Data::DEFAULT_ATTR
807 unless $type == 116; 809 unless $type == 116;
808 810
809 my (%ignore); 811 my (%ignore);
810 my (@section_order, %section, @attr_order); 812 my (@section_order, %section, @attr_order);
811 813
812 while (my $type = shift @import) { 814 while (my $type = shift @import) {
813 push @import, 815 push @import,
814 grep $_, 816 grep $_,
815 map $Crossfire::Data::TYPE{$_}, 817 map $Deliantra::Data::TYPE{$_},
816 @{$type->{import} || []}; 818 @{$type->{import} || []};
817 819
818 $attr->{$_} ||= $type->{$_} 820 $attr->{$_} ||= $type->{$_}
819 for qw(name desc use); 821 for qw(name desc use);
820 822

Diff Legend

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