… | |
… | |
10 | |
10 | |
11 | use strict; |
11 | use strict; |
12 | |
12 | |
13 | use base 'Exporter'; |
13 | use base 'Exporter'; |
14 | |
14 | |
|
|
15 | use Carp (); |
15 | use Storable; |
16 | use Storable; |
16 | |
17 | |
17 | #XXX: The map_* procedures scream for a map-object |
18 | #XXX: The map_* procedures scream for a map-object |
18 | |
19 | |
19 | our @EXPORT = |
20 | our @EXPORT = |
… | |
… | |
21 | arch_extends |
22 | arch_extends |
22 | map_get_tile_stack map_push_tile_stack map_pop_tile_stack |
23 | map_get_tile_stack map_push_tile_stack map_pop_tile_stack |
23 | ); |
24 | ); |
24 | |
25 | |
25 | our $LIB = $ENV{CROSSFIRE_LIBDIR} |
26 | our $LIB = $ENV{CROSSFIRE_LIBDIR} |
26 | or die "\$CROSSFIRE_LIBDIR must be set\n"; |
27 | or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n"; |
27 | |
28 | |
28 | sub TILESIZE (){ 32 } |
29 | sub TILESIZE (){ 32 } |
29 | |
30 | |
30 | our $ARCH; |
31 | our $ARCH; |
|
|
32 | |
|
|
33 | our %FIELD_MULTILINE = ( |
|
|
34 | msg => "endmsg", |
|
|
35 | ); |
|
|
36 | |
|
|
37 | # not used yet, maybe alphabetical is ok |
|
|
38 | our @FIELD_ORDER = (qw(name name_pl)); |
|
|
39 | |
|
|
40 | # not used yet, AND NOT CHECKED, should also be BY TYPE |
|
|
41 | our %FIELD_NORMALIZE = ( |
|
|
42 | "enter_x" => "hp", |
|
|
43 | "enter_y" => "sp", |
|
|
44 | ); |
31 | |
45 | |
32 | sub read_pak($;$) { |
46 | sub read_pak($;$) { |
33 | my ($path, $cache) = @_; |
47 | my ($path, $cache) = @_; |
34 | |
48 | |
35 | eval { |
49 | eval { |
… | |
… | |
38 | && Storable::retrieve $cache |
52 | && Storable::retrieve $cache |
39 | } or do { |
53 | } or do { |
40 | my %pak; |
54 | my %pak; |
41 | |
55 | |
42 | open my $fh, "<:raw", $path |
56 | open my $fh, "<:raw", $path |
43 | or die "$_[0]: $!"; |
57 | or Carp::croak "$_[0]: $!"; |
44 | while (<$fh>) { |
58 | while (<$fh>) { |
45 | my ($type, $id, $len, $path) = split; |
59 | my ($type, $id, $len, $path) = split; |
46 | $path =~ s/.*\///; |
60 | $path =~ s/.*\///; |
47 | read $fh, $pak{$path}, $len; |
61 | read $fh, $pak{$path}, $len; |
48 | } |
62 | } |
… | |
… | |
64 | } or do { |
78 | } or do { |
65 | my %arc; |
79 | my %arc; |
66 | my ($more, $prev); |
80 | my ($more, $prev); |
67 | |
81 | |
68 | open my $fh, "<:raw", $path |
82 | open my $fh, "<:raw", $path |
69 | or die "$path: $!"; |
83 | or Carp::croak "$path: $!"; |
70 | |
84 | |
71 | my $parse_block; $parse_block = sub { |
85 | my $parse_block; $parse_block = sub { |
72 | my %arc = @_; |
86 | my %arc = @_; |
73 | |
87 | |
74 | while (<$fh>) { |
88 | while (<$fh>) { |