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.17 by root, Wed Feb 22 22:36:45 2006 UTC vs.
Revision 1.29 by root, Thu Feb 23 13:22:10 2006 UTC

… …
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
15use Carp (); 15use Carp ();
16use Storable; 16use Storable;
17use File::Spec;
17use List::Util qw(min max); 18use List::Util qw(min max);
18 19
19#XXX: The map_* procedures scream for a map-object 20#XXX: The map_* procedures scream for a map-object
20 21
21our @EXPORT = 22our @EXPORT =
… …
24our $LIB = $ENV{CROSSFIRE_LIBDIR} 25our $LIB = $ENV{CROSSFIRE_LIBDIR}
25 or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n"; 26 or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n";
26 27
27sub TILESIZE (){ 32 } 28sub TILESIZE (){ 32 }
28 29
29our $CACHEDIR; 30our $VARDIR;
30our %ARCH; 31our %ARCH;
31our %FACE; 32our %FACE;
32our $TILE; 33our $TILE;
33 34
34our %FIELD_MULTILINE = ( 35our %FIELD_MULTILINE = (
… …
43sub MOVE_FLY_LOW (){ 0x2 } 44sub MOVE_FLY_LOW (){ 0x2 }
44sub MOVE_FLY_HIGH (){ 0x4 } 45sub MOVE_FLY_HIGH (){ 0x4 }
45sub MOVE_FLYING (){ 0x6 } 46sub MOVE_FLYING (){ 0x6 }
46sub MOVE_SWIM (){ 0x8 } 47sub MOVE_SWIM (){ 0x8 }
47sub MOVE_ALL (){ 0xf } 48sub MOVE_ALL (){ 0xf }
49
50sub load_ref($) {
51 my ($path) = @_;
52
53 open my $fh, "<:raw", "$path~"
54 or die "$path~: $!";
55 local $/;
56 Storable::thaw <$fh>
57}
58
59sub save_ref($$) {
60 my ($ref, $path) = @_;
61
62 open my $fh, ">:raw", "$path~"
63 or die "$path~: $!";
64 print $fh Storable::nfreeze $ref;
65 close $fh;
66 rename "$path~", $path
67 or die "$path: $!";
68}
48 69
49sub normalize_arch($) { 70sub normalize_arch($) {
50 my ($ob) = @_; 71 my ($ob) = @_;
51 72
52 my $arch = $ARCH{$ob->{_name}} 73 my $arch = $ARCH{$ob->{_name}}
… …
113 my ($path, $cache) = @_; 134 my ($path, $cache) = @_;
114 135
115 eval { 136 eval {
116 defined $cache 137 defined $cache
117 && -M $cache < -M $path 138 && -M $cache < -M $path
118 && Storable::retrieve $cache 139 && load_ref $cache
119 } or do { 140 } or do {
120 my %pak; 141 my %pak;
121 142
122 open my $fh, "<:raw", $path 143 open my $fh, "<:raw", $path
123 or Carp::croak "$_[0]: $!"; 144 or Carp::croak "$_[0]: $!";
… …
125 my ($type, $id, $len, $path) = split; 146 my ($type, $id, $len, $path) = split;
126 $path =~ s/.*\///; 147 $path =~ s/.*\///;
127 read $fh, $pak{$path}, $len; 148 read $fh, $pak{$path}, $len;
128 } 149 }
129 150
130 Storable::nstore \%pak, $cache 151 save_ref \%pak, $cache
131 if defined $cache; 152 if defined $cache;
132 153
133 \%pak 154 \%pak
134 } 155 }
135} 156}
… …
138 my ($path, $cache) = @_; 159 my ($path, $cache) = @_;
139 160
140 eval { 161 eval {
141 defined $cache 162 defined $cache
142 && -M $cache < -M $path 163 && -M $cache < -M $path
143 && Storable::retrieve $cache 164 && load_ref $cache
144 } or do { 165 } or do {
145 my %arc; 166 my %arc;
146 my ($more, $prev); 167 my ($more, $prev);
147 168
148 open my $fh, "<:raw", $path 169 open my $fh, "<:raw", $path
… …
203 } 224 }
204 } 225 }
205 226
206 undef $parse_block; # work around bug in perl not freeing $fh etc. 227 undef $parse_block; # work around bug in perl not freeing $fh etc.
207 228
208 Storable::nstore \%arc, $cache 229 save_ref \%arc, $cache
209 if defined $cache; 230 if defined $cache;
210 231
211 \%arc 232 \%arc
212 } 233 }
213} 234}
… …
264 # single face 285 # single face
265 return (0, 0, 0, 0); 286 return (0, 0, 0, 0);
266 } 287 }
267} 288}
268 289
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 290=item $type = arch_attr $arch
278 291
279Returns a hashref describing the object and its attributes. It can contain 292Returns a hashref describing the object and its attributes. It can contain
280the following keys: 293the following keys:
281 294
282 name the name, suitable for display purposes 295 name the name, suitable for display purposes
283 ignore 296 ignore
284 attr 297 attr
285 desc 298 desc
286 use 299 use
287 section => [name => \%attr, name => \%attr] 300 section => [name => \%attr, name => \%attr]
301 import
288 302
289=cut 303=cut
290 304
291sub arch_attr($) { 305sub arch_attr($) {
292 my ($arch) = @_; 306 my ($arch) = @_;
293 307
294 require Crossfire::Data; 308 require Crossfire::Data;
295 309
296 my %attr; 310 my $attr;
297 311
298 if ($arch->{type} > 0) { 312 if ($arch->{type} > 0) {
299 %attr = %{ $Crossfire::Data::ATTR{$arch->{type}+0} || {} }; 313 $attr = $Crossfire::Data::ATTR{$arch->{type}+0};
300 } else { 314 } else {
301 die; 315 $attr = $Crossfire::Data::TYPE{Misc};
302 }
303 316
304 use PApp::Util; 317 type:
305 warn PApp::Util::dumpval \%attr; 318 for (@Crossfire::Data::ATTR0) {
319 my $req = $_->{required}
320 or die "internal error: ATTR0 without 'required'";
321
322 while (my ($k, $v) = each %$req) {
323 next type
324 unless $arch->{$k} == $v;
325 }
326
327 $attr = $_;
328 }
329 }
330
331 $attr || \%Crossfire::Data::DEFAULT_ATTR;
306} 332}
307 333
308sub arch_edit_sections { 334sub arch_edit_sections {
309# if (edit_type == IGUIConstants.TILE_EDIT_NONE) 335# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
310# edit_type = 0; 336# edit_type = 0;
… …
364# return(edit_type); 390# return(edit_type);
365# 391#
366# 392#
367} 393}
368 394
369$CACHEDIR ||= "$ENV{HOME}/.crossfire"; 395sub init($) {
396 my ($cachedir) = @_;
370 397
398 return if %ARCH;
399
400 mkdir $cachedir, 0777;
401 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
402}
403
404$VARDIR ||= $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir . "/crossfire";
405
371init $CACHEDIR; 406init $VARDIR;
372 407
373=head1 AUTHOR 408=head1 AUTHOR
374 409
375 Marc Lehmann <schmorp@schmorp.de> 410 Marc Lehmann <schmorp@schmorp.de>
376 http://home.schmorp.de/ 411 http://home.schmorp.de/

Diff Legend

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