ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/collect.pl.in
Revision: 1.1.1.2 (vendor branch)
Committed: Wed Feb 22 18:02:04 2006 UTC (18 years, 3 months ago) by elmex
Branch: UPSTREAM
CVS Tags: UPSTREAM_2006_02_22
Changes since 1.1.1.1: +12 -5 lines
Log Message:
cvs -z7 -d:ext:elmex@cvs.schmorp.de:/schmorpforge import cf.schmorp.de UPSTREAM UPSTREAM_2006_02_22

File Contents

# Content
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,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 $smooths = "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("$smooths");
90 open(SMOOTHS,">".$smooths) || &die("cannot open ".$smooths);
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 the first path
226 # name component 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 informations 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 }