1 |
#!@PERL@ |
2 |
|
3 |
require "util.pl"; |
4 |
|
5 |
if ($#ARGV >= 0) { |
6 |
if ($ARGV[0] =~ m/^--?[hH](elp)?$/) { |
7 |
die ("\nUSAGE: perl collect.pl ARCHDIR\n". |
8 |
"\nWhere ARCHDIR is the directory where you stored the ". |
9 |
"raw archetypes.\n". |
10 |
"This script will then create these files:\n". |
11 |
"archetypes,bmaps,bmaps.paths,faces,smooth,treasures.bld,animations.\n" |
12 |
) |
13 |
} |
14 |
} |
15 |
|
16 |
# archonly is used to only build the archetypes. I find this |
17 |
# very handy if I know I've only changed .arc files - I don't want |
18 |
# to rebuild the other files, because now cvs tries to do diffs |
19 |
# on them as well as commit them, even if there are no changes. |
20 |
$archonly = 0; |
21 |
if ($#ARGV >= 1) { |
22 |
if ($ARGV[1] eq "ARCHONLY") { $archonly = 1; } |
23 |
else {print "Ignoring unknown option: $ARGV[1]\n"; } |
24 |
} |
25 |
|
26 |
|
27 |
$root = $ARGV[0]; |
28 |
$archetypes = "archetypes"; |
29 |
$bmaps = "bmaps"; |
30 |
$faces = "faces"; |
31 |
$treasures = "treasures.bld"; |
32 |
$animations = "animations"; |
33 |
$paths = $bmaps."."."paths"; |
34 |
$faceExt = "\\.[a-zA-Z0-9][A-Z0-9][A-Z0-9]"; |
35 |
$smooth = "smooth"; |
36 |
|
37 |
### main |
38 |
&info("looking ..."); |
39 |
&traverse($root); |
40 |
|
41 |
$attacktype{ 'physical' } = ( 1 << 0 ); |
42 |
$attacktype{ 'magic' } = ( 1 << 1 ); |
43 |
$attacktype{ 'fire' } = ( 1 << 2 ); |
44 |
$attacktype{ 'electricity' } = ( 1 << 3 ); |
45 |
$attacktype{ 'cold' } = ( 1 << 4 ); |
46 |
$attacktype{ 'confusion' } = ( 1 << 5 ); |
47 |
$attacktype{ 'acid' } = ( 1 << 6 ); |
48 |
$attacktype{ 'drain' } = ( 1 << 7 ); |
49 |
$attacktype{ 'weaponmagic' } = ( 1 << 8 ); |
50 |
$attacktype{ 'ghosthit' } = ( 1 << 9 ); |
51 |
$attacktype{ 'poison' } = ( 1 << 10 ); |
52 |
$attacktype{ 'slow' } = ( 1 << 11 ); |
53 |
$attacktype{ 'paralyze' } = ( 1 << 12 ); |
54 |
$attacktype{ 'turnundead' } = ( 1 << 13 ); |
55 |
$attacktype{ 'fear' } = ( 1 << 14 ); |
56 |
$attacktype{ 'cancellation' } = ( 1 << 15 ); |
57 |
$attacktype{ 'deplete' } = ( 1 << 16 ); |
58 |
$attacktype{ 'death' } = ( 1 << 17 ); |
59 |
$attacktype{ 'chaos' } = ( 1 << 18 ); |
60 |
$attacktype{ 'counterspell' } = ( 1 << 19 ); |
61 |
$attacktype{ 'godpower' } = ( 1 << 20 ); |
62 |
$attacktype{ 'holyword' } = ( 1 << 21 ); |
63 |
$attacktype{ 'blind' } = ( 1 << 22 ); |
64 |
$attacktype{ 'internal' } = ( 1 << 23 ); |
65 |
$attacktype{ 'lifestealing' } = ( 1 << 24 ); |
66 |
$attacktype{ 'disease' } = ( 1 << 25 ); |
67 |
|
68 |
&info("writing ...$archetypes"); |
69 |
open(ARCH,">".$archetypes) || &die("cannot open ".$archetypes); |
70 |
&archsOut($root); |
71 |
close(ARCH); |
72 |
|
73 |
|
74 |
if (!$archonly) { |
75 |
&info("$bmaps"); |
76 |
open(BMAPS,">".$bmaps) || &die("cannot open ".$bmaps); |
77 |
&bmapsOut; |
78 |
close(BMAPS); |
79 |
|
80 |
open(BMAPS,">".$paths) || &die("cannot open ".$paths); |
81 |
&pathsOut; |
82 |
close(BMAPS); |
83 |
|
84 |
&info("$faces"); |
85 |
open(FACES,">".$faces) || &die("cannot open ".$faces); |
86 |
&facesOut; |
87 |
close(FACES); |
88 |
|
89 |
&info("$smooth"); |
90 |
open(SMOOTHS,">".$smooth) || &die("cannot open ".$smooth); |
91 |
&smoothOut; |
92 |
close(SMOOTHS); |
93 |
|
94 |
&info("$treasures"); |
95 |
# We still support the old consolidated treasure information |
96 |
# so copy it over. |
97 |
open(TREASURES,">".$treasures) || &die("cannot open ".$treasures); |
98 |
print TREASURES "# |
99 |
# Do not modify this file - any changes will get overwritten. |
100 |
# instead, modify the treasures file or the .trs file in the |
101 |
# arch directory.\n# |
102 |
"; |
103 |
|
104 |
open(TR, "<treasures"); |
105 |
while (<TR>) { |
106 |
print TREASURES $_; |
107 |
} |
108 |
close(TR); |
109 |
print TREASURES "#\n# Start of collected .trs files\n#\n"; |
110 |
|
111 |
&treasuresOut; |
112 |
close(TREASURES); |
113 |
|
114 |
&info("$animations"); |
115 |
open(ANIM,">".$animations) || &die("cannot open ".$animations); |
116 |
&animOut; |
117 |
close(ANIM); |
118 |
} |
119 |
|
120 |
|
121 |
&stats; |
122 |
exit 0; |
123 |
|
124 |
sub traverse { |
125 |
local($dir) = shift; |
126 |
local($file,$name); |
127 |
local( $tfile); |
128 |
|
129 |
opendir(THISDIR, $dir) || die "couldn't open $dir"; |
130 |
local(@allfiles) = readdir(THISDIR); |
131 |
closedir(THISDIR); |
132 |
|
133 |
foreach $tfile (sort @allfiles) { |
134 |
next if $tfile =~ /^\./; |
135 |
$file = $dir."/".$tfile; |
136 |
$name = &basename($file,""); # DIR |
137 |
|
138 |
if( -d $file && $name ne "dev" && $name ne "trashbin" && $name ne "CVS" ) { |
139 |
&traverse($file); |
140 |
} elsif ( -d $file && ( $name eq "dev" || $name eq "trashbin" ) ) { |
141 |
# Empty directive to prevent warnings below |
142 |
} elsif( $file =~ /.*\.arc$/) { # ARCHETYPE |
143 |
$archsNum++; |
144 |
push(@archs,$file);n |
145 |
} elsif( $name =~ /(\S+)\.base($faceExt)\.png$/) { # FACE |
146 |
$facesNum++; |
147 |
$im_name = "$1$2"; |
148 |
&warn("duplicate face $im_name in ".$dir." and $faces{$im_name}") |
149 |
if $faces{$im_name}; |
150 |
$faces{$im_name} = $dir."/".$im_name; |
151 |
|
152 |
} elsif ( $file =~ /.*\.face$/) { # Face information file |
153 |
$facesFileNum++; |
154 |
push(@face_files, $file); |
155 |
} elsif ( $file =~ /.*\.trs$/) { # Treasure information file |
156 |
push(@treasure_files, $file); |
157 |
} |
158 |
elsif ( $file =~ /\.png$/ || $file =~ /\.xpm$/ || $file =~ /$faceExt$/) { |
159 |
# we cover many files we probably shouldn't, but oh well. |
160 |
# we just don't want complaints about all of these. |
161 |
} |
162 |
# ignore a couple of the more common 'junk' files that are not |
163 |
# really junk. |
164 |
elsif (($name ne "README") && ($name ne "CVS")) { |
165 |
$trashNum++; |
166 |
print "Warning: $file might be a junk file\n"; |
167 |
} |
168 |
} |
169 |
} |
170 |
|
171 |
sub storeFaceInfo { |
172 |
local($lface,@values) = @_; |
173 |
|
174 |
if ($values[0] ne "") { |
175 |
# blank.111 is a special case - |
176 |
# since no foreground pixels will actually be drawn, foreground colors is |
177 |
# not relevant. Several monsters use blank.111 as part of their |
178 |
# animation to make them appear invisible, but have some other |
179 |
# foreground color set. |
180 |
# Same applies to empty also. |
181 |
if ($fg{$lface} && $fg{$lface} ne $values[0] && $lface ne "blank.111" |
182 |
&& $lface ne "empty.111") { |
183 |
&warn($arch." duplicate fg color ".$fg{$lface}."/".$values[0]." face ".$lface); |
184 |
} else { |
185 |
$fg{$lface} = $values[0]; |
186 |
} |
187 |
} |
188 |
if ($values[1] ne "") { |
189 |
if ($bg{$lface} && $bg{$lface} ne $values[1]) { |
190 |
&warn($arch." duplicate bg color ".$bg{$lface}."/".$values[1]." face ".$lface); |
191 |
} else { |
192 |
$bg{$lface} = $values[1]; |
193 |
} |
194 |
} |
195 |
if ($values[2] ne "" && $lface ne "blank.111" && $lface ne "empty.111") { |
196 |
# blank.111 is a special case - see above explanation |
197 |
# Its visibility is always 0. |
198 |
if ($visibility{$lface} && $visibility{$lface} ne $values[2]) { |
199 |
&warn($arch." duplicate visibilty ".$visibility{$lface}."/".$values[2]." face ".$lface); |
200 |
} else { |
201 |
$visibility{$lface} = $values[2]; |
202 |
} |
203 |
} |
204 |
if ($values[3] ne "" && lface ne "blank.111" && $lface ne "empty.111") { |
205 |
if ($magicmap{$lface} && $magicmap{$lface} ne $values[3]) { |
206 |
&warn($arch." duplicate magicmap color ".$magicmap{$lface}."/".$values[3]." face ".$lface); |
207 |
} else { |
208 |
$magicmap{$lface} = $values[3]; |
209 |
} |
210 |
} |
211 |
if ($values[4] ne "") { |
212 |
if ($floor{$lface} && $floor{$lface} ne $values[4]) { |
213 |
&warn($arch." duplicate floor information ".$floor{$lface}."/".$values[4]." face ".$lface); |
214 |
} else { |
215 |
$floor{$lface} = $values[4]; |
216 |
} |
217 |
} |
218 |
} |
219 |
|
220 |
|
221 |
sub archsOut { |
222 |
local($dir) = shift; |
223 |
|
224 |
foreach $arch (@archs) { |
225 |
# Assume the filename $arch begins with $dir. Assign all path name |
226 |
# components after $dir to $pathto. |
227 |
if($arch =~ /^\Q$dir\E\/(.*)\/[^\/]*[.]arc$/) { |
228 |
$pathto = $1; |
229 |
} else { |
230 |
&warn("cannot determine editor_folder from arch '$arch'"); |
231 |
$pathto = ""; |
232 |
} |
233 |
open(ARC,$arch) || &die("cannot open ".$arch); |
234 |
line: while(<ARC>) { |
235 |
chop; |
236 |
($var,@values) = split; |
237 |
if ($var eq "#") { |
238 |
#developper comment, switch to next line |
239 |
$commentNum++; |
240 |
next line; |
241 |
} |
242 |
if ($var eq "Object") { |
243 |
$lface[0] = ""; |
244 |
$#lface = 0; |
245 |
$lfg = ""; |
246 |
$lbg = ""; |
247 |
$lvis = ""; |
248 |
$mm = ""; |
249 |
$floor = ""; |
250 |
$walkon = 0; |
251 |
$nopick = 0; |
252 |
$arch = join "_", @values; |
253 |
} |
254 |
if ($var eq "end") { |
255 |
if ($#lface !=0) { |
256 |
$#lface--; |
257 |
foreach $face (@lface) { |
258 |
&storeFaceInfo($face, $lfg, $lbg, $lvis,$mm,$floor); |
259 |
} |
260 |
} |
261 |
if ($walkon && !$nopick) { |
262 |
&warn("File $arch has an object with walk_on set which can be picked up\n"); |
263 |
} |
264 |
} |
265 |
# Process the color/face info now |
266 |
if ($var eq "color_fg") { |
267 |
$lfg = $values[0]; |
268 |
next line; |
269 |
} |
270 |
if ($var eq "color_bg") { |
271 |
$lbg = $values[0]; |
272 |
next line; |
273 |
} |
274 |
if ($var eq "end") { |
275 |
print ARCH "editor_folder $pathto\n" if $pathto ne ""; |
276 |
} |
277 |
if ($var eq "visibility") { |
278 |
$lvis = $values[0]; |
279 |
next line; |
280 |
} |
281 |
if ($var eq "magicmap") { |
282 |
$mm = $values[0]; |
283 |
next line; |
284 |
} |
285 |
if ($var eq "attacktype") { |
286 |
$at = 0; |
287 |
foreach $t ( @values ) { |
288 |
if ( $t =~ /^\d+$/ ) { |
289 |
$at |= $t; |
290 |
} else { |
291 |
if ( defined( $attacktype{ $t } ) ) { |
292 |
$at |= $attacktype{ $t }; |
293 |
} else { |
294 |
&warn($arch . " has invalid attacktype " . $t); |
295 |
} |
296 |
} |
297 |
} |
298 |
$_ = $var . ' ' . $at; |
299 |
} |
300 |
if ($var eq "is_floor") { |
301 |
$floor = $values[0]; |
302 |
# is_floor is also needed for archs, so let it pass |
303 |
# through |
304 |
} |
305 |
elsif ($var eq "no_pick") { |
306 |
$nopick = $values[0]; |
307 |
} elsif ($var eq "walk_on") { |
308 |
$walkon = $values[0]; |
309 |
} |
310 |
elsif ($var eq "face") { |
311 |
$lface[$#lface++] = $values[0] |
312 |
} |
313 |
elsif ($var eq "anim") { |
314 |
if ($anim{$arch}) { |
315 |
&warn("$arch is a duplicate animation name"); |
316 |
$anim{$arch}=""; |
317 |
} |
318 |
while (<ARC>) { |
319 |
chomp; |
320 |
$var = $_; |
321 |
last if ($var =~ "mina\s*"); |
322 |
if ($var =~ /facings \S+$/) { } |
323 |
elsif (! $faces{$var}) { |
324 |
&warn($arch." is missing face ".$var); |
325 |
} |
326 |
else { |
327 |
$lface[$#lface++] = $var; |
328 |
} |
329 |
$anim{$arch} .= "$var\n"; |
330 |
} |
331 |
print ARCH "animation $arch\n"; |
332 |
next line; # don't want the mina |
333 |
} |
334 |
if ($var eq "face" && ! $faces{$values[0]}) { |
335 |
&warn($arch." is missing face ".$values[0]) |
336 |
} |
337 |
if ($var eq "smoothface") { |
338 |
if ($smoothing{$values[0]} && ($smoothing{$values[0]} ne $values[1])) { |
339 |
&warn($arch." duplicate smoothface for ".$values[0].": ".$smoothing{$values[0]}." and ".$values[1]); |
340 |
} elsif ( ($values[0] eq "") || ($values[1] eq "")) { |
341 |
&warn ($arch." incomplete smoothface entry found: ".$values[0]." ".$values[1]); |
342 |
} else { |
343 |
$smoothing{$values[0]}=$values[1] |
344 |
} |
345 |
next line; #smoothface must be excluded from archetype file |
346 |
} |
347 |
print ARCH $_,"\n"; |
348 |
} |
349 |
close(ARC); |
350 |
} |
351 |
} |
352 |
|
353 |
sub pline { |
354 |
local($face) = shift; |
355 |
print BMAPS sprintf("%05d",$idx++)," ",$face,"\n"; |
356 |
} |
357 |
|
358 |
sub opline { |
359 |
local($face) = shift; |
360 |
print BMAPS sprintf("\\%05d",$idx++),"\t",$face,"\n"; |
361 |
} |
362 |
|
363 |
sub pheader { |
364 |
print BMAPS "# This file is generated by $0, do not edit\n"; |
365 |
} |
366 |
|
367 |
sub bmapsOut { |
368 |
&pheader; |
369 |
$idx = 0; |
370 |
&pline("bug.111"); |
371 |
foreach $face (sort(keys %faces)) { |
372 |
&pline($face) if $face !~ /bug\.111/; |
373 |
} |
374 |
} |
375 |
|
376 |
sub pathsOut { |
377 |
&pheader; |
378 |
$idx = 0; |
379 |
&opline($root."/system/bug.111"); |
380 |
foreach $face (sort(keys %faces)) { |
381 |
&opline($faces{$face}) if $faces{$face} !~ /bug\.111/; |
382 |
} |
383 |
} |
384 |
|
385 |
sub treasuresOut { |
386 |
foreach $treasure (@treasure_files) { |
387 |
open(TREAS, $treasure) || &die("cannot open ".$treasure); |
388 |
while(<TREAS>) { |
389 |
if (! /^\s*$/) { |
390 |
print TREASURES $_; |
391 |
} |
392 |
} |
393 |
close(FACE); |
394 |
} |
395 |
} |
396 |
|
397 |
sub facesOut { |
398 |
foreach $face (@face_files) { |
399 |
open(FACE, $face) || &die("cannot open ".$face); |
400 |
while(<FACE>) { |
401 |
chop; |
402 |
local ($var, @values) = split; |
403 |
if ($var eq "face") { |
404 |
$lface = $values[0]; |
405 |
$lfg = ""; |
406 |
$lbg = ""; |
407 |
$lvis = ""; |
408 |
$mm = ""; |
409 |
$floor = ""; |
410 |
} |
411 |
elsif ($var eq "color_fg") { |
412 |
$lfg = $values[0]; |
413 |
} |
414 |
elsif ($var eq "color_bg") { |
415 |
$lbg = $values[0]; |
416 |
} |
417 |
elsif ($var eq "visibility") { |
418 |
$lvis = $values[0]; |
419 |
} |
420 |
elsif ($var eq "magicmap") { |
421 |
$mm = $values[0]; |
422 |
} |
423 |
elsif ($var eq "is_floor") { |
424 |
$floor = $values[0]; |
425 |
} |
426 |
elsif ($var eq "end") { |
427 |
&storeFaceInfo($lface, $lfg, $lbg, $lvis, $mm, $floor); |
428 |
} |
429 |
elsif ($var eq "animation") { |
430 |
$animation=$values[0]; |
431 |
if ($anim{$1}) { |
432 |
&warn("$animation is a duplicate animation name"); |
433 |
$anim{$animation}=""; |
434 |
} |
435 |
while (<FACE>) { |
436 |
chomp; |
437 |
$var = $_; |
438 |
last if ($var =~ /^mina\s*$/); |
439 |
if ($var !~ /^facings/ ) { |
440 |
if (! $faces{$var}) { |
441 |
&warn($arch." is missing face ".$var); |
442 |
} |
443 |
else { |
444 |
$lface[$#lface++] = $var; |
445 |
} |
446 |
} |
447 |
$anim{$animation} .= "$var\n"; |
448 |
} |
449 |
next; # don't want the mina |
450 |
} |
451 |
} |
452 |
close(FACE); |
453 |
} |
454 |
print FACES "# This file is generated by $0, do not edit\n"; |
455 |
foreach $face (sort(keys %faces)) { |
456 |
if ($fg{$face} ne "" || $bg{$face} ne "" || $visibility{$face} ne "" || |
457 |
$magicmap{$face} ne "" || $floor{$face} ne "") { |
458 |
print FACES "face ".$face."\n"; |
459 |
print FACES "color_fg ".$fg{$face}."\n" |
460 |
if $fg{$face} ne ""; |
461 |
print FACES "color_bg ".$bg{$face}."\n" |
462 |
if $bg{$face} ne ""; |
463 |
print FACES "visibility ".$visibility{$face}."\n" |
464 |
if $visibility{$face} ne ""; |
465 |
print FACES "magicmap ".$magicmap{$face}."\n" |
466 |
if $magicmap{$face} ne ""; |
467 |
print FACES "is_floor ".$floor{$face}."\n" |
468 |
if $floor{$face} ne ""; |
469 |
print FACES "end\n"; |
470 |
} |
471 |
} |
472 |
} |
473 |
|
474 |
sub animOut { |
475 |
foreach $anim (sort keys %anim) { |
476 |
print ANIM "anim $anim\n$anim{$anim}mina\n"; |
477 |
$animationsNum++; |
478 |
} |
479 |
} |
480 |
sub smoothOut { |
481 |
local ($sm); |
482 |
print SMOOTHS "##########################################################\n"; |
483 |
print SMOOTHS "# Do not touch this file. #\n"; |
484 |
print SMOOTHS "# It has been generated from the information present #\n"; |
485 |
print SMOOTHS "# in the archetype files. #\n"; |
486 |
print SMOOTHS "# To add new entries, simply add #\n"; |
487 |
print SMOOTHS "# smoothface xxx yyy #\n"; |
488 |
print SMOOTHS "# to an archetype and collect.pl will put below an entry #\n"; |
489 |
print SMOOTHS "# xxx yyy #\n"; |
490 |
print SMOOTHS "##########################################################\n\n"; |
491 |
print SMOOTHS "# default smooth. Needed for fallbacking\n"; |
492 |
print SMOOTHS "default_smoothed.111 sdefault.001\n"; |
493 |
print SMOOTHS "\n# Data extracted from arch files\n"; |
494 |
foreach $sm (sort (keys %smoothing)) { |
495 |
print SMOOTHS "$sm $smoothing{$sm}\n"; |
496 |
$smoothNum++; |
497 |
} |
498 |
} |
499 |
|
500 |
### print out statical information |
501 |
sub stats { |
502 |
&info(Archs.":\t".$archsNum); |
503 |
&info(Images.":\t".$facesNum); |
504 |
&info(Faces.":\t".$facesFileNum); |
505 |
&info(Animations.":\t".$animationsNum); |
506 |
&info(Treasures.":\t".($#treasure_files+1)); |
507 |
&info(Trash.":\t".$trashNum); |
508 |
&info(Smooths.":\t".$smoothNum); |
509 |
&info("Comment lines:\t".$commentNum); |
510 |
} |