1 |
root |
1.1 |
#!/opt/bin/perl |
2 |
|
|
|
3 |
|
|
# tries to convert cave tiles to caveh tiles, depending |
4 |
|
|
# on their surroundings |
5 |
|
|
|
6 |
|
|
# --guess switch enabled heuristic, otherwise, blocksview 0 is used |
7 |
|
|
|
8 |
|
|
use common::sense; |
9 |
|
|
|
10 |
|
|
use Deliantra; |
11 |
|
|
use Deliantra::Map; |
12 |
|
|
|
13 |
|
|
Deliantra::load_archetypes; |
14 |
|
|
|
15 |
|
|
our $heuristic = $ARGV[0] eq "--guess" ? (shift, 1) : 0; |
16 |
|
|
|
17 |
|
|
our $map; |
18 |
|
|
our $cols; |
19 |
|
|
|
20 |
|
|
# blackness parts |
21 |
|
|
my %bn = ( |
22 |
|
|
cave1 => 1+2+4, |
23 |
|
|
cave2 => 2+4+8, |
24 |
|
|
cave3 => 1+4+8, |
25 |
|
|
cave4 => 1+2+8, |
26 |
|
|
cave5 => 1+2, |
27 |
|
|
cave6 => 2+4, |
28 |
|
|
cave7 => 4+8, |
29 |
|
|
cave8 => 1+8, |
30 |
|
|
cave9 => 1+8, |
31 |
|
|
cave10 => 1+2, |
32 |
|
|
cave11 => 2+4, |
33 |
|
|
cave12 => 4+8, |
34 |
|
|
cave13 => 1+8, |
35 |
|
|
cave14 => 1+2, |
36 |
|
|
cave15 => 2+4, |
37 |
|
|
cave16 => 4+8, |
38 |
|
|
cave17 => 1+2+4+8, |
39 |
|
|
cave18 => 1+2+4+8, |
40 |
|
|
cave19 => 1+2+4+8, |
41 |
|
|
cave20 => 1+2+4+8, |
42 |
|
|
cave21 => 0, |
43 |
|
|
cave22 => 1+2+4+8, |
44 |
|
|
cave23 => 1+2+4+8, |
45 |
|
|
cave24 => 1+2+4+8, |
46 |
|
|
cave25 => 1+2+4+8, |
47 |
|
|
); |
48 |
|
|
|
49 |
|
|
sub xy($$) { |
50 |
|
|
my ($x, $y) = @_; |
51 |
|
|
|
52 |
|
|
$x >= 0 && $x < $map->{width} |
53 |
|
|
&& $y >= 0 && $y < $map->{height} |
54 |
|
|
? $cols->[$_[0]][$_[1]] |
55 |
|
|
: undef |
56 |
|
|
} |
57 |
|
|
|
58 |
|
|
# on-map, not "blocked", has floor |
59 |
|
|
sub nonblocked($$) { |
60 |
|
|
my $as = &xy |
61 |
|
|
or return 1; |
62 |
|
|
|
63 |
|
|
@$as |
64 |
|
|
or return; |
65 |
|
|
|
66 |
|
|
$as->[-1]{_name} eq "blocked" |
67 |
|
|
and return; |
68 |
|
|
|
69 |
|
|
grep $ARCH{$_->{_name}}{is_floor}, @$as |
70 |
|
|
} |
71 |
|
|
|
72 |
|
|
for my $path (@ARGV) { |
73 |
|
|
eval { |
74 |
|
|
open my $fh, "<:raw:perlio:utf8", $path |
75 |
|
|
or die "$path: $!\n"; |
76 |
|
|
|
77 |
|
|
<$fh> =~ /^arch map$/ |
78 |
|
|
or die "$path: not a deliantra map file\n"; |
79 |
|
|
|
80 |
|
|
local $map = new_from_file Deliantra::Map $path |
81 |
|
|
or die "$path: file load error\n"; |
82 |
|
|
|
83 |
|
|
local $cols = $map->{map}; |
84 |
|
|
|
85 |
|
|
for my $x (0 .. $#$cols) { |
86 |
|
|
my $col = $cols->[$x] |
87 |
|
|
or next; |
88 |
|
|
|
89 |
|
|
for my $y (0 .. $#$col) { |
90 |
|
|
my $as = $col->[$y]; |
91 |
|
|
|
92 |
|
|
grep $ARCH{$_->{_name}}{is_floor}, @$as |
93 |
|
|
or next; |
94 |
|
|
|
95 |
|
|
for my $cave (@$as) { |
96 |
|
|
my $bn = $bn{ $cave->{_name} } |
97 |
|
|
or next; |
98 |
|
|
|
99 |
|
|
if ($cave->{blocksview} ne 0) { |
100 |
|
|
$heuristic or next; |
101 |
|
|
|
102 |
|
|
$bn ^= 15; |
103 |
|
|
|
104 |
|
|
# H/V |
105 |
|
|
$bn & 1 or nonblocked $x , $y-1 or next; |
106 |
|
|
$bn & 2 or nonblocked $x+1, $y or next; |
107 |
|
|
$bn & 4 or nonblocked $x , $y+1 or next; |
108 |
|
|
$bn & 8 or nonblocked $x-1, $y or next; |
109 |
|
|
|
110 |
|
|
# diagonal |
111 |
|
|
$bn & 3 or nonblocked $x+1, $y-1 or next; |
112 |
|
|
$bn & 6 or nonblocked $x+1, $y+1 or next; |
113 |
|
|
$bn & 12 or nonblocked $x-1, $y+1 or next; |
114 |
|
|
$bn & 9 or nonblocked $x-1, $y-1 or next; |
115 |
|
|
} |
116 |
|
|
|
117 |
|
|
$cave->{_name} =~ s/^cave/caveh/; |
118 |
|
|
} |
119 |
|
|
} |
120 |
|
|
} |
121 |
|
|
|
122 |
|
|
$map->write_file ($path); |
123 |
|
|
|
124 |
|
|
1 |
125 |
|
|
} or warn $@; |
126 |
|
|
} |
127 |
|
|
|