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.35 by root, Sun Mar 12 16:23:56 2006 UTC

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

Diff Legend

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