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.30 by root, Thu Feb 23 14:54:44 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 FreezeThaw qw(freeze thaw)";
52 } else {
53 eval "use Storable qw(freeze thaw)";
54 }
55}
56
57sub load_ref($) {
58 my ($path) = @_;
59
60 open my $fh, "<:raw", "$path~"
61 or die "$path~: $!";
62 local $/;
63 thaw <$fh>
64}
65
66sub save_ref($$) {
67 my ($ref, $path) = @_;
68
69 open my $fh, ">:raw", "$path~"
70 or die "$path~: $!";
71 my $ref = freeze $ref;
72 print $fh $ref;
73 close $fh;
74 rename "$path~", $path
75 or die "$path: $!";
76}
48 77
49sub normalize_arch($) { 78sub normalize_arch($) {
50 my ($ob) = @_; 79 my ($ob) = @_;
51 80
52 my $arch = $ARCH{$ob->{_name}} 81 my $arch = $ARCH{$ob->{_name}}
… …
113 my ($path, $cache) = @_; 142 my ($path, $cache) = @_;
114 143
115 eval { 144 eval {
116 defined $cache 145 defined $cache
117 && -M $cache < -M $path 146 && -M $cache < -M $path
118 && Storable::retrieve $cache 147 && load_ref $cache
119 } or do { 148 } or do {
120 my %pak; 149 my %pak;
121 150
122 open my $fh, "<:raw", $path 151 open my $fh, "<:raw", $path
123 or Carp::croak "$_[0]: $!"; 152 or Carp::croak "$_[0]: $!";
… …
125 my ($type, $id, $len, $path) = split; 154 my ($type, $id, $len, $path) = split;
126 $path =~ s/.*\///; 155 $path =~ s/.*\///;
127 read $fh, $pak{$path}, $len; 156 read $fh, $pak{$path}, $len;
128 } 157 }
129 158
130 Storable::nstore \%pak, $cache 159 save_ref \%pak, $cache
131 if defined $cache; 160 if defined $cache;
132 161
133 \%pak 162 \%pak
134 } 163 }
135} 164}
… …
138 my ($path, $cache) = @_; 167 my ($path, $cache) = @_;
139 168
140 eval { 169 eval {
141 defined $cache 170 defined $cache
142 && -M $cache < -M $path 171 && -M $cache < -M $path
143 && Storable::retrieve $cache 172 && load_ref $cache
144 } or do { 173 } or do {
145 my %arc; 174 my %arc;
146 my ($more, $prev); 175 my ($more, $prev);
147 176
148 open my $fh, "<:raw", $path 177 open my $fh, "<:raw", $path
… …
203 } 232 }
204 } 233 }
205 234
206 undef $parse_block; # work around bug in perl not freeing $fh etc. 235 undef $parse_block; # work around bug in perl not freeing $fh etc.
207 236
208 Storable::nstore \%arc, $cache 237 save_ref \%arc, $cache
209 if defined $cache; 238 if defined $cache;
210 239
211 \%arc 240 \%arc
212 } 241 }
213} 242}
… …
264 # single face 293 # single face
265 return (0, 0, 0, 0); 294 return (0, 0, 0, 0);
266 } 295 }
267} 296}
268 297
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 298=item $type = arch_attr $arch
278 299
279Returns a hashref describing the object and its attributes. It can contain 300Returns a hashref describing the object and its attributes. It can contain
280the following keys: 301the following keys:
281 302
282 name the name, suitable for display purposes 303 name the name, suitable for display purposes
283 ignore 304 ignore
284 attr 305 attr
285 desc 306 desc
286 use 307 use
287 section => [name => \%attr, name => \%attr] 308 section => [name => \%attr, name => \%attr]
309 import
288 310
289=cut 311=cut
290 312
291sub arch_attr($) { 313sub arch_attr($) {
292 my ($arch) = @_; 314 my ($arch) = @_;
… …
312 334
313 $attr = $_; 335 $attr = $_;
314 } 336 }
315 } 337 }
316 338
317 use PApp::Util; 339 $attr || \%Crossfire::Data::DEFAULT_ATTR;
318 warn PApp::Util::dumpval $attr;
319} 340}
320 341
321sub arch_edit_sections { 342sub arch_edit_sections {
322# if (edit_type == IGUIConstants.TILE_EDIT_NONE) 343# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
323# edit_type = 0; 344# edit_type = 0;
… …
377# return(edit_type); 398# return(edit_type);
378# 399#
379# 400#
380} 401}
381 402
382$CACHEDIR ||= "$ENV{HOME}/.crossfire"; 403sub init($) {
404 my ($cachedir) = @_;
383 405
406 return if %ARCH;
407
408 mkdir $cachedir, 0777;
409 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
410}
411
412$VARDIR ||= $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir . "/crossfire";
413
384init $CACHEDIR; 414init $VARDIR;
385 415
386=head1 AUTHOR 416=head1 AUTHOR
387 417
388 Marc Lehmann <schmorp@schmorp.de> 418 Marc Lehmann <schmorp@schmorp.de>
389 http://home.schmorp.de/ 419 http://home.schmorp.de/

Diff Legend

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