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.134 by root, Wed Oct 28 10:17:01 2009 UTC vs.
Revision 1.147 by root, Wed Nov 7 12:04:36 2018 UTC

… …
6 6
7=cut 7=cut
8 8
9package Deliantra; 9package Deliantra;
10 10
11our $VERSION = '1.25'; 11our $VERSION = '2.01';
12 12
13use common::sense; 13use common::sense;
14 14
15use base 'Exporter'; 15use base 'Exporter';
16 16
… …
56 56
57# same as in server save routine, to (hopefully) be compatible 57# same as in server save routine, to (hopefully) be compatible
58# to the other editors. 58# to the other editors.
59our @FIELD_ORDER_MAP = (qw( 59our @FIELD_ORDER_MAP = (qw(
60 file_format_version 60 file_format_version
61 name attach swap_time reset_timeout fixed_resettime difficulty region 61 name attach swap_time reset_timeout fixed_resettime difficulty
62 region music
62 shopitems shopgreed shopmin shopmax shoprace 63 shopitems shopgreed shopmin shopmax shoprace
63 darkness width height enter_x enter_y msg maplore 64 darkness width height enter_x enter_y msg maplore
64 unique template 65 unique template
65 outdoor temp pressure humid windspeed winddir sky nosmooth 66 outdoor temp pressure humid windspeed winddir sky nosmooth
66 tile_path_1 tile_path_2 tile_path_3 tile_path_4 67 tile_path_1 tile_path_2 tile_path_3 tile_path_4
… …
72 elevation 73 elevation
73 74
74 name name_pl custom_name attach title race 75 name name_pl custom_name attach title race
75 slaying skill msg lore other_arch 76 slaying skill msg lore other_arch
76 sound sound_destroy face animation is_animated 77 sound sound_destroy face animation is_animated
77 magicmap smoothlevel smoothface 78 magicmap glyph smoothlevel smoothface
78 str dex con wis pow cha int 79 str dex con wis pow cha int
79 hp maxhp sp maxsp grace maxgrace 80 hp maxhp sp maxsp grace maxgrace
80 exp perm_exp expmul 81 exp perm_exp expmul
81 food dam luck wc ac x y speed speed_left move_state attack_movement 82 food dam luck wc ac x y speed speed_left move_state attack_movement
82 nrof level direction type subtype attacktype 83 nrof level direction type subtype attacktype
… …
132 trigger => 10, 133 trigger => 10,
133 close => 11, 134 close => 11,
134 timer => 12, 135 timer => 12,
135); 136);
136 137
138# 1 up 2 right 4 down 8 left
139our %WALLDIR = (
140 0 => 0,
141 1_2 => 1,
142 1_4 => 2,
143 2_2_1 => 3,
144 1_1 => 4,
145 2_1_1 => 5,
146 2_2_2 => 6,
147 3_2 => 7,
148 1_3 => 8,
149 2_2_4 => 9,
150 2_1_2 => 10,
151 3_1 => 11,
152 2_2_3 => 12,
153 3_4 => 13,
154 3_3 => 14,
155 4 => 15,
156);
157
137sub MOVE_WALK (){ 0x01 } 158sub MOVE_WALK (){ 0x01 }
138sub MOVE_FLY_LOW (){ 0x02 } 159sub MOVE_FLY_LOW (){ 0x02 }
139sub MOVE_FLY_HIGH (){ 0x04 } 160sub MOVE_FLY_HIGH (){ 0x04 }
140sub MOVE_FLYING (){ 0x06 } 161sub MOVE_FLYING (){ 0x06 }
141sub MOVE_SWIM (){ 0x08 } 162sub MOVE_SWIM (){ 0x08 }
… …
162 183
163 use overload 184 use overload
164 '=' => sub { bless [@{$_[0]}], ref $_[0] }, 185 '=' => sub { bless [@{$_[0]}], ref $_[0] },
165 '""' => \&as_string, 186 '""' => \&as_string,
166 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, 187 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
188 '<=' => sub {
189 ($_[0][0] & $MOVE_TYPE{$_[1]}) == $MOVE_TYPE{$_[1]}
190 ? $_[0][1] & $MOVE_TYPE{$_[1]}
191 : undef
192 },
167 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise }, 193 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise },
168 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise }, 194 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise },
169 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise }, 195 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise },
170 'x=' => sub { 196 'x=' => sub { # toggle between off, + and -
171 my $cur = $_[0] >= $_[1]; 197 my $cur = $_[0] >= $_[1];
172 if (!defined $cur) { 198 if (!defined $cur) {
173 if ($_[0] >= "all") { 199 if ($_[0] >= "all") {
174 $_[0] -= $_[1]; 200 $_[0] -= $_[1];
175 } else { 201 } else {
… …
339 365
340# object as in "Object xxx", i.e. archetypes 366# object as in "Object xxx", i.e. archetypes
341sub normalize_object($) { 367sub normalize_object($) {
342 my ($ob) = @_; 368 my ($ob) = @_;
343 369
370 delete $ob->{editable}; # deprecated
371
344 # convert material bitset to materialname, if possible 372 # convert material bitset to materialname, if possible
345 if (exists $ob->{material}) { 373 if (exists $ob->{material}) {
346 if (!$ob->{material}) { 374 if (!$ob->{material}) {
347 delete $ob->{material}; 375 delete $ob->{material};
348 } elsif (exists $ob->{materialname}) { 376 } elsif (exists $ob->{materialname}) {
… …
807 } else { 835 } else {
808 $root = $Deliantra::Data::TYPE{Misc}; 836 $root = $Deliantra::Data::TYPE{Misc};
809 } 837 }
810 } 838 }
811 839
840 my (%ignore);
812 my @import = ($root); 841 my @import = ($root);
813
814 unshift @import, \%Deliantra::Data::DEFAULT_ATTR
815 unless $type == 116;
816 842
817 my (%ignore); 843 my @new_import;
818 my (@section_order, %section, @attr_order);
819
820 while (my $type = shift @import) { 844 while (my $type = shift @import) {
845 # first import everything we will need:
821 push @import, 846 push @import,
822 grep $_, 847 grep $_,
823 map $Deliantra::Data::TYPE{$_}, 848 map $Deliantra::Data::TYPE{$_},
824 @{$type->{import} || []}; 849 @{$type->{import} || []};
825 850
851 # and compute the ignored attributes
852 for (@{$type->{ignore} || []}) {
853 $ignore{$_}++ for ref $_ ? @$_ : $_;
854 }
855
856 push @new_import, $type;
857 }
858 (@import) = @new_import;
859
860 # then add defaults to the back of the list, so they are added
861 # as last resort.
862 push @import, \%Deliantra::Data::DEFAULT_ATTR
863 unless $type == 116;
864
865 my (@section_order, %section, @attr_order);
866
867 # @import = root, imported, default
868 while (my $type = pop @import) {
826 $attr->{$_} ||= $type->{$_} 869 $attr->{$_} ||= $type->{$_}
827 for qw(name desc use); 870 for qw(name desc use);
828
829 for (@{$type->{ignore} || []}) {
830 $ignore{$_}++ for ref $_ ? @$_ : $_;
831 }
832 871
833 for ([general => ($type->{attr} || [])], @{$type->{section} || []}) { 872 for ([general => ($type->{attr} || [])], @{$type->{section} || []}) {
834 my ($name, $attr) = @$_; 873 my ($name, $attr) = @$_;
835 push @section_order, $name; 874 push @section_order, $name;
836 for (@$attr) { 875 for (@$attr) {
837 my ($k, $v) = @$_; 876 my ($k, $v) = @$_;
838 push @attr_order, $k; 877 push @attr_order, $k;
839 $section{$name}{$k} ||= $v; 878 $section{$name}{$k} = $v; # overwrite, so that the root decides
840 }
841 } 879 }
880 }
881 }
882
883 # remove ignores for "root" type
884 for (
885 map @{$_->[1]}, # section attributes
886 [general => ($root->{attr} || [])],
887 @{$root->{section} || []}
888 ) {
889 my ($k, $v) = @$_;
890 # skip fixed attributes, if they are ignored thats fine
891 next if $v->{type} eq 'fixed';
892
893 delete $ignore{$k}; # if the attributes are defined explicitly they
894 # should NOT be ignored. ignore should mainly
895 # hit imported/inherited attributes.
842 } 896 }
843 897
844 $attr->{section} = [ 898 $attr->{section} = [
845 map !exists $section{$_} ? () : do { 899 map !exists $section{$_} ? () : do {
846 my $attr = delete $section{$_}; 900 my $attr = delete $section{$_};
… …
850 map exists $attr->{$_} && !$ignore{$_} 904 map exists $attr->{$_} && !$ignore{$_}
851 ? [$_ => delete $attr->{$_}] : (), 905 ? [$_ => delete $attr->{$_}] : (),
852 @attr_order 906 @attr_order
853 ] 907 ]
854 }, 908 },
855
856 exists $section{$_} ? [$_ => delete $section{$_}] : (), 909 exists $section{$_} ? [$_ => delete $section{$_}] : (),
857 @section_order 910 @section_order
858 ]; 911 ];
859 912
860 $attr 913 $attr
861} 914}
… …
957 require Gtk2; 1010 require Gtk2;
958 1011
959 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache, 1012 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
960 sub { 1013 sub {
961 my %cache; 1014 my %cache;
962 my $facedata = Storable::retrieve "$LIB/facedata"; 1015 my $facedata = Storable::retrieve "$LIB/faceinfo";
1016
1017 open my $fh, "<", "$LIB/facedata"
1018 or die "$LIB/facedata: $!";
963 1019
964 $facedata->{version} == 2 1020 $facedata->{version} == 2
965 or die "$LIB/facedata: version mismatch, cannot proceed."; 1021 or die "$LIB/facedata: version mismatch, cannot proceed.";
966 1022
967 my $faces = $facedata->{faceinfo}; 1023 my $faces = $facedata->{faceinfo};
… …
969 1025
970 for (sort keys %$faces) { 1026 for (sort keys %$faces) {
971 my ($face, $info) = ($_, $faces->{$_}); 1027 my ($face, $info) = ($_, $faces->{$_});
972 1028
973 my $pb = new Gtk2::Gdk::PixbufLoader; 1029 my $pb = new Gtk2::Gdk::PixbufLoader;
1030
1031 if (exists $info->{data32}) {
974 $pb->write ($info->{data32}); 1032 $pb->write ($info->{data32});
1033 } else {
1034 sysseek $fh, $info->{fofs32}, 0;
1035 sysread $fh, my $buf, $info->{size32};
1036 $pb->write ($buf);
1037 }
975 $pb->close; 1038 $pb->close;
976 my $pb = $pb->get_pixbuf; 1039 my $pb = $pb->get_pixbuf;
977 1040
978 my $tile = $cache{$face} = { 1041 my $tile = $cache{$face} = {
979 pb => $pb, 1042 pb => $pb,

Diff Legend

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