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.32 by root, Thu Feb 23 15:10:08 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 die if $^O eq "MSWin32"; #d#
61
62 open my $fh, "<", $path
63 or die "$path: $!";
64 binmode $fh;
65 local $/;
66 thaw <$fh>
67}
68
69sub save_ref($$) {
70 my ($ref, $path) = @_;
71
72 open my $fh, ">", "$path~"
73 or die "$path~: $!";
74 binmode $fh;
75 print $fh freeze $ref;
76 close $fh;
77 rename "$path~", $path
78 or die "$path: $!";
79}
48 80
49sub normalize_arch($) { 81sub normalize_arch($) {
50 my ($ob) = @_; 82 my ($ob) = @_;
51 83
52 my $arch = $ARCH{$ob->{_name}} 84 my $arch = $ARCH{$ob->{_name}}
… …
113 my ($path, $cache) = @_; 145 my ($path, $cache) = @_;
114 146
115 eval { 147 eval {
116 defined $cache 148 defined $cache
117 && -M $cache < -M $path 149 && -M $cache < -M $path
118 && Storable::retrieve $cache 150 && load_ref $cache
119 } or do { 151 } or do {
120 my %pak; 152 my %pak;
121 153
122 open my $fh, "<:raw", $path 154 open my $fh, "<", $path
123 or Carp::croak "$_[0]: $!"; 155 or Carp::croak "$_[0]: $!";
156 binmode $fh;
124 while (<$fh>) { 157 while (<$fh>) {
125 my ($type, $id, $len, $path) = split; 158 my ($type, $id, $len, $path) = split;
126 $path =~ s/.*\///; 159 $path =~ s/.*\///;
127 read $fh, $pak{$path}, $len; 160 read $fh, $pak{$path}, $len;
128 } 161 }
129 162
130 Storable::nstore \%pak, $cache 163 save_ref \%pak, $cache
131 if defined $cache; 164 if defined $cache;
132 165
133 \%pak 166 \%pak
134 } 167 }
135} 168}
… …
138 my ($path, $cache) = @_; 171 my ($path, $cache) = @_;
139 172
140 eval { 173 eval {
141 defined $cache 174 defined $cache
142 && -M $cache < -M $path 175 && -M $cache < -M $path
143 && Storable::retrieve $cache 176 && load_ref $cache
144 } or do { 177 } or do {
145 my %arc; 178 my %arc;
146 my ($more, $prev); 179 my ($more, $prev);
147 180
148 open my $fh, "<:raw", $path 181 open my $fh, "<", $path
149 or Carp::croak "$path: $!"; 182 or Carp::croak "$path: $!";
183
184 binmode $fh;
150 185
151 my $parse_block; $parse_block = sub { 186 my $parse_block; $parse_block = sub {
152 my %arc = @_; 187 my %arc = @_;
153 188
154 while (<$fh>) { 189 while (<$fh>) {
… …
203 } 238 }
204 } 239 }
205 240
206 undef $parse_block; # work around bug in perl not freeing $fh etc. 241 undef $parse_block; # work around bug in perl not freeing $fh etc.
207 242
208 Storable::nstore \%arc, $cache 243 save_ref \%arc, $cache
209 if defined $cache; 244 if defined $cache;
210 245
211 \%arc 246 \%arc
212 } 247 }
213} 248}
… …
264 # single face 299 # single face
265 return (0, 0, 0, 0); 300 return (0, 0, 0, 0);
266 } 301 }
267} 302}
268 303
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 304=item $type = arch_attr $arch
278 305
279Returns a hashref describing the object and its attributes. It can contain 306Returns a hashref describing the object and its attributes. It can contain
280the following keys: 307the following keys:
281 308
282 name the name, suitable for display purposes 309 name the name, suitable for display purposes
283 ignore 310 ignore
284 attr 311 attr
285 desc 312 desc
286 use 313 use
287 section => [name => \%attr, name => \%attr] 314 section => [name => \%attr, name => \%attr]
315 import
288 316
289=cut 317=cut
290 318
291sub arch_attr($) { 319sub arch_attr($) {
292 my ($arch) = @_; 320 my ($arch) = @_;
293 321
294 require Crossfire::Data; 322 require Crossfire::Data;
295 323
296 my %attr; 324 my $attr;
297 325
298 if ($arch->{type} > 0) { 326 if ($arch->{type} > 0) {
299 %attr = %{ $Crossfire::Data::ATTR{$arch->{type}+0} || {} }; 327 $attr = $Crossfire::Data::ATTR{$arch->{type}+0};
300 } else { 328 } else {
301 die; 329 $attr = $Crossfire::Data::TYPE{Misc};
302 }
303 330
304 use PApp::Util; 331 type:
305 warn PApp::Util::dumpval \%attr; 332 for (@Crossfire::Data::ATTR0) {
333 my $req = $_->{required}
334 or die "internal error: ATTR0 without 'required'";
335
336 while (my ($k, $v) = each %$req) {
337 next type
338 unless $arch->{$k} == $v;
339 }
340
341 $attr = $_;
342 }
343 }
344
345 $attr || \%Crossfire::Data::DEFAULT_ATTR;
306} 346}
307 347
308sub arch_edit_sections { 348sub arch_edit_sections {
309# if (edit_type == IGUIConstants.TILE_EDIT_NONE) 349# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
310# edit_type = 0; 350# edit_type = 0;
… …
364# return(edit_type); 404# return(edit_type);
365# 405#
366# 406#
367} 407}
368 408
369$CACHEDIR ||= "$ENV{HOME}/.crossfire"; 409sub init($) {
410 my ($cachedir) = @_;
370 411
412 return if %ARCH;
413
414 mkdir $cachedir, 0777;
415 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
416}
417
418$VARDIR ||= $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir . "/crossfire";
419
371init $CACHEDIR; 420init $VARDIR;
372 421
373=head1 AUTHOR 422=head1 AUTHOR
374 423
375 Marc Lehmann <schmorp@schmorp.de> 424 Marc Lehmann <schmorp@schmorp.de>
376 http://home.schmorp.de/ 425 http://home.schmorp.de/

Diff Legend

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