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.18 by root, Wed Feb 22 22:41:22 2006 UTC vs.
Revision 1.33 by root, Thu Feb 23 15:47:50 2006 UTC

… …
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
15use Carp (); 15use Carp ();
16use Storable; 16use File::Spec;
17use List::Util qw(min max); 17use List::Util qw(min max);
18 18
19#XXX: The map_* procedures scream for a map-object 19#XXX: The map_* procedures scream for a map-object
20 20
21our @EXPORT = 21our @EXPORT =
… …
24our $LIB = $ENV{CROSSFIRE_LIBDIR} 24our $LIB = $ENV{CROSSFIRE_LIBDIR}
25 or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n"; 25 or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n";
26 26
27sub TILESIZE (){ 32 } 27sub TILESIZE (){ 32 }
28 28
29our $CACHEDIR; 29our $VARDIR;
30our %ARCH; 30our %ARCH;
31our %FACE; 31our %FACE;
32our $TILE; 32our $TILE;
33 33
34our %FIELD_MULTILINE = ( 34our %FIELD_MULTILINE = (
… …
43sub MOVE_FLY_LOW (){ 0x2 } 43sub MOVE_FLY_LOW (){ 0x2 }
44sub MOVE_FLY_HIGH (){ 0x4 } 44sub MOVE_FLY_HIGH (){ 0x4 }
45sub MOVE_FLYING (){ 0x6 } 45sub MOVE_FLYING (){ 0x6 }
46sub MOVE_SWIM (){ 0x8 } 46sub MOVE_SWIM (){ 0x8 }
47sub MOVE_ALL (){ 0xf } 47sub MOVE_ALL (){ 0xf }
48
49BEGIN {
50 if ($^O eq "MSWin32") {
51 eval "use Data::Dumper";
52 } else {
53 eval "use Storable qw(freeze thaw)";
54 }
55}
56
57sub load_ref($) {
58 my ($path) = @_;
59
60 open my $fh, "<", $path
61 or die "$path: $!";
62 binmode $fh;
63 local $/;
64
65 $^O eq "MSWin32" ? eval <$fh> : thaw (<$fh>)
66}
67
68sub save_ref($$) {
69 my ($ref, $path) = @_;
70
71 open my $fh, ">", "$path~"
72 or die "$path~: $!";
73 binmode $fh;
74 print $fh $^O eq "MSWin32"
75 ? Data::Dumper->new ([$ref])->Deepcopy (1)->Purity (1)->Terse (1)->Indent (0)->Dump
76 : freeze ($ref);
77 close $fh;
78 rename "$path~", $path
79 or die "$path: $!";
80}
48 81
49sub normalize_arch($) { 82sub normalize_arch($) {
50 my ($ob) = @_; 83 my ($ob) = @_;
51 84
52 my $arch = $ARCH{$ob->{_name}} 85 my $arch = $ARCH{$ob->{_name}}
… …
113 my ($path, $cache) = @_; 146 my ($path, $cache) = @_;
114 147
115 eval { 148 eval {
116 defined $cache 149 defined $cache
117 && -M $cache < -M $path 150 && -M $cache < -M $path
118 && Storable::retrieve $cache 151 && load_ref $cache
119 } or do { 152 } or do {
120 my %pak; 153 my %pak;
121 154
122 open my $fh, "<:raw", $path 155 open my $fh, "<", $path
123 or Carp::croak "$_[0]: $!"; 156 or Carp::croak "$_[0]: $!";
157 binmode $fh;
124 while (<$fh>) { 158 while (<$fh>) {
125 my ($type, $id, $len, $path) = split; 159 my ($type, $id, $len, $path) = split;
126 $path =~ s/.*\///; 160 $path =~ s/.*\///;
127 read $fh, $pak{$path}, $len; 161 read $fh, $pak{$path}, $len;
128 } 162 }
129 163
130 Storable::nstore \%pak, $cache 164 save_ref \%pak, $cache
131 if defined $cache; 165 if defined $cache;
132 166
133 \%pak 167 \%pak
134 } 168 }
135} 169}
… …
138 my ($path, $cache) = @_; 172 my ($path, $cache) = @_;
139 173
140 eval { 174 eval {
141 defined $cache 175 defined $cache
142 && -M $cache < -M $path 176 && -M $cache < -M $path
143 && Storable::retrieve $cache 177 && load_ref $cache
144 } or do { 178 } or do {
145 my %arc; 179 my %arc;
146 my ($more, $prev); 180 my ($more, $prev);
147 181
148 open my $fh, "<:raw", $path 182 open my $fh, "<", $path
149 or Carp::croak "$path: $!"; 183 or Carp::croak "$path: $!";
184
185 binmode $fh;
150 186
151 my $parse_block; $parse_block = sub { 187 my $parse_block; $parse_block = sub {
152 my %arc = @_; 188 my %arc = @_;
153 189
154 while (<$fh>) { 190 while (<$fh>) {
… …
203 } 239 }
204 } 240 }
205 241
206 undef $parse_block; # work around bug in perl not freeing $fh etc. 242 undef $parse_block; # work around bug in perl not freeing $fh etc.
207 243
208 Storable::nstore \%arc, $cache 244 save_ref \%arc, $cache
209 if defined $cache; 245 if defined $cache;
210 246
211 \%arc 247 \%arc
212 } 248 }
213} 249}
… …
264 # single face 300 # single face
265 return (0, 0, 0, 0); 301 return (0, 0, 0, 0);
266 } 302 }
267} 303}
268 304
269sub init($) {
270 my ($cachedir) = @_;
271
272 return if %ARCH;
273
274 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
275}
276
277=item $data = arch_attr $arch 305=item $type = arch_attr $arch
278 306
279Returns a hashref describing the object and its attributes. It can contain 307Returns a hashref describing the object and its attributes. It can contain
280the following keys: 308the following keys:
281 309
282 name the name, suitable for display purposes 310 name the name, suitable for display purposes
283 ignore 311 ignore
284 attr 312 attr
285 desc 313 desc
286 use 314 use
287 section => [name => \%attr, name => \%attr] 315 section => [name => \%attr, name => \%attr]
316 import
288 317
289=cut 318=cut
290 319
291sub arch_attr($) { 320sub arch_attr($) {
292 my ($arch) = @_; 321 my ($arch) = @_;
… …
312 341
313 $attr = $_; 342 $attr = $_;
314 } 343 }
315 } 344 }
316 345
317 use PApp::Util; 346 $attr || \%Crossfire::Data::DEFAULT_ATTR;
318 warn PApp::Util::dumpval $attr;
319} 347}
320 348
321sub arch_edit_sections { 349sub arch_edit_sections {
322# if (edit_type == IGUIConstants.TILE_EDIT_NONE) 350# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
323# edit_type = 0; 351# edit_type = 0;
… …
377# return(edit_type); 405# return(edit_type);
378# 406#
379# 407#
380} 408}
381 409
382$CACHEDIR ||= "$ENV{HOME}/.crossfire"; 410sub init($) {
411 my ($cachedir) = @_;
383 412
413 return if %ARCH;
414
415 mkdir $cachedir, 0777;
416 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
417}
418
419$VARDIR ||= $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir . "/crossfire";
420
384init $CACHEDIR; 421init $VARDIR;
385 422
386=head1 AUTHOR 423=head1 AUTHOR
387 424
388 Marc Lehmann <schmorp@schmorp.de> 425 Marc Lehmann <schmorp@schmorp.de>
389 http://home.schmorp.de/ 426 http://home.schmorp.de/

Diff Legend

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