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

Diff Legend

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