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 |
|