ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/collect.pl.in
Revision: 1.1.1.1 (vendor branch)
Committed: Fri Feb 3 07:13:04 2006 UTC (18 years, 3 months ago) by root
Branch: UPSTREAM
CVS Tags: UPSTREAM_2006_02_03
Changes since 1.1: +0 -0 lines
Log Message:
initial import

File Contents

# User Rev Content
1 root 1.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;
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     foreach $arch (@archs) {
223     open(ARC,$arch) || &die("cannot open ".$arch);
224     $pathto = $arch;
225     $pathto =~ s@[^/]*/@@;
226     $pathto =~ s@[a-z]*/(.*)/.*arc@$1@;
227     line: while(<ARC>) {
228     chop;
229     ($var,@values) = split;
230     if ($var eq "#") {
231     #developper comment, switch to next line
232     $commentNum++;
233     next line;
234     }
235     if ($var eq "Object") {
236     $lface[0] = "";
237     $#lface = 0;
238     $lfg = "";
239     $lbg = "";
240     $lvis = "";
241     $mm = "";
242     $floor = "";
243     $walkon = 0;
244     $nopick = 0;
245     $arch = join "_", @values;
246     }
247     if ($var eq "end") {
248     if ($#lface !=0) {
249     $#lface--;
250     foreach $face (@lface) {
251     &storeFaceInfo($face, $lfg, $lbg, $lvis,$mm,$floor);
252     }
253     }
254     if ($walkon && !$nopick) {
255     &warn("File $arch has an object with walk_on set which can be picked up\n");
256     }
257     }
258     # Process the color/face info now
259     if ($var eq "color_fg") {
260     $lfg = $values[0];
261     next line;
262     }
263     if ($var eq "color_bg") {
264     $lbg = $values[0];
265     next line;
266     }
267     if ($var eq "end") {
268     print ARCH "editor_folder $pathto\n";
269     }
270     if ($var eq "visibility") {
271     $lvis = $values[0];
272     next line;
273     }
274     if ($var eq "magicmap") {
275     $mm = $values[0];
276     next line;
277     }
278     if ($var eq "attacktype") {
279     $at = 0;
280     foreach $t ( @values ) {
281     if ( $t =~ /^\d+$/ ) {
282     $at |= $t;
283     } else {
284     if ( defined( $attacktype{ $t } ) ) {
285     $at |= $attacktype{ $t };
286     } else {
287     &warn($arch . " has invalid attacktype " . $t);
288     }
289     }
290     }
291     $_ = $var . ' ' . $at;
292     }
293     if ($var eq "is_floor") {
294     $floor = $values[0];
295     # is_floor is also needed for archs, so let it pass
296     # through
297     }
298     elsif ($var eq "no_pick") {
299     $nopick = $values[0];
300     } elsif ($var eq "walk_on") {
301     $walkon = $values[0];
302     }
303     elsif ($var eq "face") {
304     $lface[$#lface++] = $values[0]
305     }
306     elsif ($var eq "anim") {
307     if ($anim{$arch}) {
308     &warn("$arch is a duplicate animation name");
309     $anim{$arch}="";
310     }
311     while (<ARC>) {
312     chomp;
313     $var = $_;
314     last if ($var =~ "mina\s*");
315     if ($var =~ /facings \S+$/) { }
316     elsif (! $faces{$var}) {
317     &warn($arch." is missing face ".$var);
318     }
319     else {
320     $lface[$#lface++] = $var;
321     }
322     $anim{$arch} .= "$var\n";
323     }
324     print ARCH "animation $arch\n";
325     next line; # don't want the mina
326     }
327     if ($var eq "face" && ! $faces{$values[0]}) {
328     &warn($arch." is missing face ".$values[0])
329     }
330     if ($var eq "smoothface") {
331     if ($smoothing{$values[0]} && ($smoothing{$values[0]} ne $values[1])) {
332     &warn($arch." duplicate smoothface for ".$values[0].": ".$smoothing{$values[0]}." and ".$values[1]);
333     } elsif ( ($values[0] eq "") || ($values[1] eq "")) {
334     &warn ($arch." incomplete smoothface entry found: ".$values[0]." ".$values[1]);
335     } else {
336     $smoothing{$values[0]}=$values[1]
337     }
338     next line; #smoothface must be excluded from archetype file
339     }
340     print ARCH $_,"\n";
341     }
342     close(ARC);
343     }
344     }
345    
346     sub pline {
347     local($face) = shift;
348     print BMAPS sprintf("%05d",$idx++)," ",$face,"\n";
349     }
350    
351     sub opline {
352     local($face) = shift;
353     print BMAPS sprintf("\\%05d",$idx++),"\t",$face,"\n";
354     }
355    
356     sub pheader {
357     print BMAPS "# This file is generated by $0, do not edit\n";
358     }
359    
360     sub bmapsOut {
361     &pheader;
362     $idx = 0;
363     &pline("bug.111");
364     foreach $face (sort(keys %faces)) {
365     &pline($face) if $face !~ /bug\.111/;
366     }
367     }
368    
369     sub pathsOut {
370     &pheader;
371     $idx = 0;
372     &opline($root."/system/bug.111");
373     foreach $face (sort(keys %faces)) {
374     &opline($faces{$face}) if $faces{$face} !~ /bug\.111/;
375     }
376     }
377    
378     sub treasuresOut {
379     foreach $treasure (@treasure_files) {
380     open(TREAS, $treasure) || &die("cannot open ".$treasure);
381     while(<TREAS>) {
382     if (! /^\s*$/) {
383     print TREASURES $_;
384     }
385     }
386     close(FACE);
387     }
388     }
389    
390     sub facesOut {
391     foreach $face (@face_files) {
392     open(FACE, $face) || &die("cannot open ".$face);
393     while(<FACE>) {
394     chop;
395     local ($var, @values) = split;
396     if ($var eq "face") {
397     $lface = $values[0];
398     $lfg = "";
399     $lbg = "";
400     $lvis = "";
401     $mm = "";
402     $floor = "";
403     }
404     elsif ($var eq "color_fg") {
405     $lfg = $values[0];
406     }
407     elsif ($var eq "color_bg") {
408     $lbg = $values[0];
409     }
410     elsif ($var eq "visibility") {
411     $lvis = $values[0];
412     }
413     elsif ($var eq "magicmap") {
414     $mm = $values[0];
415     }
416     elsif ($var eq "is_floor") {
417     $floor = $values[0];
418     }
419     elsif ($var eq "end") {
420     &storeFaceInfo($lface, $lfg, $lbg, $lvis, $mm, $floor);
421     }
422     elsif ($var eq "animation") {
423     $animation=$values[0];
424     if ($anim{$1}) {
425     &warn("$animation is a duplicate animation name");
426     $anim{$animation}="";
427     }
428     while (<FACE>) {
429     chomp;
430     $var = $_;
431     last if ($var =~ /^mina\s*$/);
432     if ($var !~ /^facings/ ) {
433     if (! $faces{$var}) {
434     &warn($arch." is missing face ".$var);
435     }
436     else {
437     $lface[$#lface++] = $var;
438     }
439     }
440     $anim{$animation} .= "$var\n";
441     }
442     next; # don't want the mina
443     }
444     }
445     close(FACE);
446     }
447     print FACES "# This file is generated by $0, do not edit\n";
448     foreach $face (sort(keys %faces)) {
449     if ($fg{$face} ne "" || $bg{$face} ne "" || $visibility{$face} ne "" ||
450     $magicmap{$face} ne "" || $floor{$face} ne "") {
451     print FACES "face ".$face."\n";
452     print FACES "color_fg ".$fg{$face}."\n"
453     if $fg{$face} ne "";
454     print FACES "color_bg ".$bg{$face}."\n"
455     if $bg{$face} ne "";
456     print FACES "visibility ".$visibility{$face}."\n"
457     if $visibility{$face} ne "";
458     print FACES "magicmap ".$magicmap{$face}."\n"
459     if $magicmap{$face} ne "";
460     print FACES "is_floor ".$floor{$face}."\n"
461     if $floor{$face} ne "";
462     print FACES "end\n";
463     }
464     }
465     }
466    
467     sub animOut {
468     foreach $anim (sort keys %anim) {
469     print ANIM "anim $anim\n$anim{$anim}mina\n";
470     $animationsNum++;
471     }
472     }
473     sub smoothOut {
474     local ($sm);
475     print SMOOTHS "##########################################################\n";
476     print SMOOTHS "# Do not touch this file. #\n";
477     print SMOOTHS "# It has been generated from the informations present #\n";
478     print SMOOTHS "# in the archetype files. #\n";
479     print SMOOTHS "# To add new entries, simply add #\n";
480     print SMOOTHS "# smoothface xxx yyy #\n";
481     print SMOOTHS "# to an archetype and collect.pl will put below an entry #\n";
482     print SMOOTHS "# xxx yyy #\n";
483     print SMOOTHS "##########################################################\n\n";
484     print SMOOTHS "# default smooth. Needed for fallbacking\n";
485     print SMOOTHS "default_smoothed.111 sdefault.001\n";
486     print SMOOTHS "\n# Data extracted from arch files\n";
487     foreach $sm (sort (keys %smoothing)) {
488     print SMOOTHS "$sm $smoothing{$sm}\n";
489     $smoothNum++;
490     }
491     }
492    
493     ### print out statical information
494     sub stats {
495     &info(Archs.":\t".$archsNum);
496     &info(Images.":\t".$facesNum);
497     &info(Faces.":\t".$facesFileNum);
498     &info(Animations.":\t".$animationsNum);
499     &info(Treasures.":\t".($#treasure_files+1));
500     &info(Trash.":\t".$trashNum);
501     &info(Smooths.":\t".$smoothNum);
502     &info("Comment lines:\t".$commentNum);
503     }