home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the Mac Game Programming Gurus / TricksOfTheMacGameProgrammingGurus.iso / More Source / C⁄C++ / Xconq 7.0d37 / source / misc / scn2g < prev    next >
Encoding:
Text File  |  1994-05-10  |  3.8 KB  |  167 lines  |  [TEXT/R*ch]
  1. #!/usr/local/bin/perl
  2. eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
  3.     if $running_under_some_shell;
  4.  
  5. require "getopts.pl";
  6. &Getopts('o:');
  7. die "Usage: scn2g [-o outfile] [infile]\n" if @ARGV > 1;
  8.  
  9. #
  10. # Get stdout set up and the default module name
  11. #
  12. if ( $opt_o ) {
  13.     #
  14.     # If they give us an output file name, open it
  15.     # and use it as the module name (minus path and extension).
  16.     #
  17.     open(STDOUT, ">$opt_o") || die "Couldn't open $opt_o for output: $!\n";
  18.     ($m = $opt_o) =~ s#(.*/)?(.*)\.g$#$2#;
  19. } elsif (@ARGV) {
  20.     #
  21.     # If they give us an input file,
  22.     # use it as the output file name (minus path and extension plus .g)
  23.     # and use it as the module name (minus path and extension).
  24.     #
  25.     ($m = $ARGV[0]) =~ s#(.*/)?(.*)\.scn$#$2#;
  26.     unless ( -e "$m.g" ) {
  27.     open(STDOUT, ">$m.g") || die "Couldn't open $m.g for output: $!\n";
  28.     }
  29. } else {
  30.     #
  31.     # OK, we got nothin', output is stdout and module name is junk.
  32.     #
  33.     $m = 'xxx';
  34. }
  35.  
  36. $\ = "\n";    # terminate every print with a newline.
  37.  
  38. @types = ( 'pt_value', 'units', 'resources', 'unit_at' );
  39.  
  40. LINE:
  41. while (<>) {
  42.     # strip trailing whitespace (and the newline).
  43.     s/\s*$//;
  44.  
  45.     if (/^Xconq (\d+) [\+-]* ([^;]*)(;?)$/) {
  46.     local($n) = $1;
  47.         print qq/(game-module "$m"\n  (blurb "$2")/;
  48.     if ( $3 ) {
  49.         print "  (game-module (notes (";
  50.         COMMENT:
  51.         while (<>) {
  52.         last COMMENT if /^\.$/;
  53.         chop;
  54.         print;
  55.         }
  56.         print "  ))";
  57.     }
  58.     while ( $n-- ) {
  59.         chop($f = <>);
  60.         print(qq/  (base-module "$1")/), next if $f =~ /^(\S*)\.per$/;
  61.         push(@incfiles, $f);
  62.     }
  63.         print ")\n";
  64.     foreach $f ( @incfiles ) {
  65.         print qq/(include "$f")/;
  66.     }
  67.     next LINE;
  68.     } elsif (/^Globals/) {
  69.     split;
  70.     &read_globs(@_[1..5]);
  71.     next LINE;
  72.     } elsif (/^Sides/) {
  73.     split;
  74.     &read_sides(@_[1], @_[2]);
  75.     next LINE;
  76.     } elsif (/^Units/) {
  77.     split;
  78.     ($num, $detail) = @_[1,2];
  79.     &read_unit($detail) while ($num--);
  80.     next LINE;
  81.     }
  82.  
  83.     s/^/;/;
  84.     print;
  85. }
  86.  
  87. sub read_globs {
  88.     local($first_turn, $last_turn, $set_prod, $leave, $conds) = @_;
  89.     local($n);
  90.  
  91.     print "; fixed production" if $set_prod;
  92.     print "; leave from edges" if $leave;
  93.     print "(set turn $first_turn)" if $first_turn;
  94.     print "(set last-turn $last_turn)";
  95.  
  96.     print "";
  97.     for ($n = 1; $n <= $conds; ++$n) {
  98.     chop($_ = <>);
  99.     local($w, $t, $st, $end, $s) = split;
  100.     $w = ($w = 0)? 'lose' : 'win';
  101.     $s++;
  102.     print qq/(scorekeeper |cond$n| (title "$types[$t]")/;
  103.     print "  (applies-to $s)" unless ($s == -1);
  104.     print "; (trigger if turn > $st and turn < $end)";
  105.  
  106.     chop($_ = <>);
  107.     print "; (do if ($types[$t] $_) $w)";
  108.  
  109.     print ")";
  110.     }
  111. }
  112.  
  113. sub read_sides {
  114.     local($num, $detail) = @_;
  115.     local($n);
  116.  
  117.     print "";
  118.     for ($n = 1; $n <= $num; ++$n) {
  119.     $_ = <>;
  120.     chop($_);
  121.     push(@sides, $_);
  122.     print qq/(side $n (name "$_")/;
  123.  
  124.     if ( $detail > 1 ) {
  125.         local(@t);
  126.         $_ = <>;
  127.         split;
  128.         for ($i = 1; $i < $num + 1; ++$i) {
  129.         push(@t, (@_[$i] == 100)? 'true' : 'false');
  130.         }
  131.         print "  (trusts @t)";
  132.     }
  133.     if ( $detail > 2 ) {
  134.         print STDERR "Oh, shit, I don't know what to do with all this";
  135.     }
  136.     print ")";
  137.     }
  138.     print "(set sides-min $num) (set sides-max $num)\n";
  139. }
  140.  
  141. sub read_unit {
  142.     local($detail) = @_;
  143.  
  144.     chop($_ = <>);
  145.     local($char, $name, $loc, $owner) = split;
  146.     $loc =~ s/,/ /;
  147.     ++$owner;
  148.     $name =~ s/\*/ /g;
  149.     print "($char $loc $owner";
  150.     print qq/  (name "$name")/ unless $name eq ' ';
  151.  
  152.     if ( $detail > 1 ) {
  153.     chop($_ = <>);
  154.     split;
  155.     local($no, $hp, $qual, $prod, $tl, $before, $trans) = @_[1,3,4,7..10];
  156.     local(@res) = splice(@_, 11);
  157.     print "  (nm $no) (hp $hp) (m @res)";
  158.     print "  (in $trans)" if $trans != -1;
  159.     print "  (cxp $qual)" if $qual != 0;
  160.     # no handling of production type, turns left in build or made before.
  161.     }
  162.     if ( $detail > 2 ) {
  163.     print STDERR "Oh, shit, I don't know what to do with all this";
  164.     }
  165.     print ")";
  166. }
  167.