1 |
#!/opt/bin/perl |
2 |
|
3 |
# read through the whole maps at .=/ and replace all exits by |
4 |
# tags that point to one of the maps given on the commandline |
5 |
# (which must be relative paths starting at .!) |
6 |
|
7 |
use strict; |
8 |
|
9 |
use Crossfire; |
10 |
use Crossfire::Map; |
11 |
use Tie::Cache; |
12 |
|
13 |
{ |
14 |
package mapcache; |
15 |
|
16 |
use base Tie::Cache::; |
17 |
|
18 |
sub read { |
19 |
new_from_file Crossfire::Map $_[1] |
20 |
} |
21 |
|
22 |
sub write { |
23 |
my ($self, $path, $map) = @_; |
24 |
warn "writing $path\n";#d# |
25 |
$map->write_file ($path); |
26 |
} |
27 |
} |
28 |
|
29 |
our %map; |
30 |
tie %map, mapcache::, 100, { Debug => 0, WriteSync => 0 } |
31 |
or die; |
32 |
|
33 |
Crossfire::load_archetypes; |
34 |
|
35 |
sub expand { |
36 |
my ($path, $base) = @_; |
37 |
|
38 |
$path =~ s/\.map$//; |
39 |
|
40 |
return +(substr $path, 1) . ".map" if $path =~ /^\//; |
41 |
|
42 |
defined $base |
43 |
or die "relative path without base"; |
44 |
|
45 |
$path = "$base/../$path.map"; |
46 |
|
47 |
1 while $path =~ s/\/+[^\/]*\/+\.\./\//; |
48 |
1 while $path =~ s/\/\//\//; |
49 |
|
50 |
$path |
51 |
} |
52 |
|
53 |
my %is_exit = ( 41 => 1, 57 => 1, 66 => 1 ); |
54 |
|
55 |
sub gen_tag { |
56 |
my ($path, $suffix, $x, $y) = @_; |
57 |
|
58 |
# create a tag name |
59 |
my $tag = $path; |
60 |
$tag =~ s/\.map$//; |
61 |
$tag =~ s/\//_/g; |
62 |
$tag .= $suffix; |
63 |
$tag .= $x <= 0 || $y <= 0 ? "_entrance" : "+${x}+${y}"; |
64 |
|
65 |
1 while $tag =~ s/\b([^_]+)_\1\b/$1/; |
66 |
|
67 |
lc $tag |
68 |
} |
69 |
|
70 |
sub patch_exit { |
71 |
my ($from, $fx, $fy, $path, $x, $y) = @_; |
72 |
|
73 |
my $map = $map{$path} |
74 |
or return; |
75 |
|
76 |
my $tag; |
77 |
|
78 |
my $tag = |
79 |
$path =~ /world/ && $from !~ /world/ |
80 |
? gen_tag $from, "_exit", $fx, $fy |
81 |
: gen_tag $path, "", $x, $y; |
82 |
|
83 |
$x = $map->{info}{enter_x} if $x <= 0; |
84 |
$y = $map->{info}{enter_y} if $y <= 0; |
85 |
|
86 |
$x >= 0 && $y >= 0 |
87 |
or ((warn "invalid x,y"), return); |
88 |
|
89 |
# 1. try to find an existing tag |
90 |
my $os = $map->{map}[$x][$y] ||= []; |
91 |
if (my ($tagged) = grep exists $_->{tag}, @$os) { |
92 |
return $tagged->{tag}; |
93 |
} |
94 |
|
95 |
# 2. find an existing exit |
96 |
if (my ($exit) = grep $is_exit{$_->{type} || $ARCH{$_->{_name}}{type}}, @$os) { |
97 |
$exit->{tag} = $tag; |
98 |
$map{$path} = $map; |
99 |
return $tag; |
100 |
} |
101 |
|
102 |
# 3. add a tag object to the bottom |
103 |
unshift @$os, { _atype => "arch", _name => "tag", tag => $tag }; |
104 |
$map{$path} = $map; |
105 |
$tag |
106 |
} |
107 |
|
108 |
open my $fh, "find * -name '*.map' -type f -print0 |" |
109 |
or die "find: $!"; |
110 |
|
111 |
my %target; |
112 |
|
113 |
for (@ARGV) { |
114 |
s/\.map$//; |
115 |
s/^\///; |
116 |
s/\/\/+/\//g; |
117 |
$_ .= ".map"; |
118 |
|
119 |
$target{$_} = 1; |
120 |
} |
121 |
|
122 |
while (defined (my $path = do { local $/ = "\x00"; <$fh> })) { |
123 |
chop $path; |
124 |
my $map = $map{$path}; |
125 |
|
126 |
for my $fx (0 .. $map->{info}{width} - 1) { |
127 |
for my $fy (0 .. $map->{info}{width} - 1) { |
128 |
my $space = $map->{map}[$fx][$fy] |
129 |
or next; |
130 |
|
131 |
for my $o (@$space) { |
132 |
my $a = $Crossfire::ARCH{$o->{_name}} |
133 |
or next; |
134 |
|
135 |
if ($is_exit{$o->{type} || $a->{type}}) { |
136 |
my ($exit, $x, $y) = ($o->{slaying}, $o->{hp}, $o->{sp}); |
137 |
if ($exit =~ /^[\/0-9a-zA-Z]/ && $exit ne "/!") { |
138 |
$exit = expand $exit, $path; |
139 |
if ($exit ne $path && ($target{$path} || $target{$exit} || 0)) { |
140 |
if (my $tag = patch_exit $path, $fx, $fy, $exit, $x, $y) { |
141 |
delete $o->{sp}; |
142 |
delete $o->{hp}; |
143 |
$o->{slaying} = "*$tag"; |
144 |
$map{$path} = $map; |
145 |
|
146 |
warn "$path: found exit $exit $x $y => *$tag\n";#d# |
147 |
} else { |
148 |
warn "$path: $exit $o->{hp} $o->{sp} unpatchable\n"; |
149 |
} |
150 |
} |
151 |
} |
152 |
} |
153 |
} |
154 |
} |
155 |
} |
156 |
} |
157 |
|
158 |
%map = (); |
159 |
|