tools/quake3/q3maporigin2originbrush.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 sub ParseEntity($)
   7 {
   8         my ($fh) = @_;
   9
  10         my %ent = ( );
  11         my @brushes = ( );
  12
  13         while(<$fh>)
  14         {
  15                 chomp; s/\r//g; s/\0//g; s/\/\/.*$//; s/^\s+//; s/\s+$//; next if /^$/;
  16
  17                 if(/^\{$/)
  18                 {
  19                         # entity starts
  20                         while(<$fh>)
  21                         {
  22                                 chomp; s/\r//g; s/\0//g; s/\/\/.*$//; s/^\s+//; s/\s+$//; next if /^$/;
  23
  24                                 if(/^"(.*?)" "(.*)"$/)
  25                                 {
  26                                         # key-value pair
  27                                         $ent{$1} = $2;
  28                                 }
  29                                 elsif(/^\{$/)
  30                                 {
  31                                         my $brush = [];
  32                                         push @brushes, $brush;
  33
  34                                         while(<$fh>)
  35                                         {
  36                                                 chomp; s/\r//g; s/\0//g; s/\/\/.*$//; s/^\s+//; s/\s+$//; next if /^$/;
  37
  38                                                 if(/^\{$/)
  39                                                 {
  40                                                         # patch?
  41                                                         push @$brush, $_;
  42
  43                                                         while(<$fh>)
  44                                                         {
  45                                                                 chomp; s/\r//g; s/\0//g; s/\/\/.*$//; s/^\s+//; s/\s+$//; next if /^$/;
  46
  47                                                                 if(/^\}$/)
  48                                                                 {
  49                                                                         push @$brush, $_;
  50
  51                                                                         last;
  52                                                                 }
  53                                                                 else
  54                                                                 {
  55                                                                         push @$brush, $_;
  56                                                                 }
  57                                                         }
  58                                                 }
  59                                                 elsif(/^\}$/)
  60                                                 {
  61                                                         # end of brush
  62                                                         last;
  63                                                 }
  64                                                 else
  65                                                 {
  66                                                         push @$brush, $_;
  67                                                 }
  68                                         }
  69                                 }
  70                                 elsif(/^\}$/)
  71                                 {
  72                                         return \%ent, \@brushes;
  73                                 }
  74                         }
  75                 }
  76                 else
  77                 {
  78                         die "Unexpected line in top level: >>$_<<";
  79                 }
  80         }
  81
  82         return undef;
  83 }
  84
  85 sub UnparseEntity($$)
  86 {
  87         my ($ent, $brushes) = @_;
  88         my %ent = %$ent;
  89
  90         my $s = "{\n";
  91
  92         for(sort keys %ent)
  93         {
  94                 $s .= "\"$_\" \"$ent{$_}\"\n";
  95         }
  96
  97         if(defined $brushes)
  98         {
  99                 for(@$brushes)
 100                 {
 101                         $s .= "{\n";
 102                         $s .= "$_\n" for @$_;
 103                         $s .= "}\n";
 104                 }
 105         }
 106
 107         $s .= "}\n";
 108         return $s;
 109 }
 110
 111 my @axialbrushpattern = (
 112         [ "+++", "+-+", "-++", " - ", "-  " ],
 113         [ "+++", "-++", "++-", "+  ", "  +" ],
 114         [ "+++", "++-", "+-+", " - ", "  +" ],
 115         [ "---", "+--", "-+-", " - ", "+  " ],
 116         [ "---", "--+", "+--", "-  ", "  +" ],
 117         [ "---", "-+-", "--+", " + ", "  +" ]
 118 );
 119 sub axialbrushpattern($$$)
 120 {
 121         my ($plane, $vertex, $coord) = @_;
 122         my $ch = substr $axialbrushpattern[$plane][$vertex], $coord, 1;
 123         return $ch eq '+' ? +1 : $ch eq '-' ? -1 : 0;
 124 }
 125 sub frac($)
 126 {
 127         my ($x) = @_;
 128         return $x - int $x;
 129 }
 130 sub ConvertOriginBrush($$$$)
 131 {
 132         my ($brushPrimit, $x, $y, $z) = @_;
 133         my @data = ();
 134         if($brushPrimit)
 135         {
 136                 push @data, "brushDef";
 137                 push @data, "{";
 138                 for(0..5)
 139                 {
 140                         push @data, sprintf
 141                                 "( %s %s %s ) ( %s %s %s ) ( %s %s %s ) ( ( %s %s %s ) ( %s %s %s ) ) common/origin 0 0 0",
 142                                 $x + 8 * axialbrushpattern($_, 0, 0), $y + 8 * axialbrushpattern($_, 0, 1), $z + 8 * axialbrushpattern($_, 0, 2),
 143                                 $x + 8 * axialbrushpattern($_, 1, 0), $y + 8 * axialbrushpattern($_, 1, 1), $z + 8 * axialbrushpattern($_, 1, 2),
 144                                 $x + 8 * axialbrushpattern($_, 2, 0), $y + 8 * axialbrushpattern($_, 2, 1), $z + 8 * axialbrushpattern($_, 2, 2),
 145                                 1/16.0, 0, frac((axialbrushpattern($_, 3, 0) * $x + axialbrushpattern($_, 3, 1) * $y + axialbrushpattern($_, 3, 2) * $z) / 16.0 + 0.5),
 146                                 0, 1/16.0, frac((axialbrushpattern($_, 4, 0) * $x + axialbrushpattern($_, 4, 1) * $y + axialbrushpattern($_, 4, 2) * $z) / 16.0 + 0.5);
 147                 }
 148                 push @data, "}";
 149         }
 150         else
 151         {
 152                 my $data = "// origin brush\n{\n";
 153                 for(0..5)
 154                 {
 155                         push @data, sprintf
 156                                 "( %s %s %s ) ( %s %s %s ) ( %s %s %s ) common/origin %s %s 0 %s %s 0 0 0",
 157                                 $x + 8 * axialbrushpattern($_, 0, 0), $y + 8 * axialbrushpattern($_, 0, 1), $z + 8 * axialbrushpattern($_, 0, 2),
 158                                 $x + 8 * axialbrushpattern($_, 1, 0), $y + 8 * axialbrushpattern($_, 1, 1), $z + 8 * axialbrushpattern($_, 1, 2),
 159                                 $x + 8 * axialbrushpattern($_, 2, 0), $y + 8 * axialbrushpattern($_, 2, 1), $z + 8 * axialbrushpattern($_, 2, 2),
 160                                 frac((axialbrushpattern($_, 3, 0) * $x + axialbrushpattern($_, 3, 1) * $y + axialbrushpattern($_, 3, 2) * $z) / 16.0 + 0.5) * 64.0,
 161                                 frac((axialbrushpattern($_, 4, 0) * $x + axialbrushpattern($_, 4, 1) * $y + axialbrushpattern($_, 4, 2) * $z) / 16.0 + 0.5) * 64.0,
 162                                 1/4.0, 1/4.0;
 163                 }
 164         }
 165         return \@data;
 166 }
 167
 168 my ($infile, $outfile) = @ARGV;
 169 open my $infh, '<', $infile
 170         or die "<$infile: $!";
 171 my $brushPrimit = 0;
 172
 173 my $outbuf = "";
 174 for(;;)
 175 {
 176         my ($ent, $brushes) = ParseEntity $infh;
 177         defined $ent
 178                 or last;
 179         if(@$brushes)
 180         {
 181                 $brushPrimit = 1
 182                         if grep { m!\s+brushDef\s+!; } @$brushes;
 183                 if(grep { m!\s+common/origin\s+!; } @$brushes)
 184                 {
 185                         # we have origin brushes - good
 186                 }
 187                 else
 188                 {
 189                         if(defined $ent->{origin})
 190                         {
 191                                 my $origin = [ split /\s+/, ($ent->{origin} || "0 0 0") ];
 192                                 delete $ent->{origin};
 193                                 push @$brushes, ConvertOriginBrush $brushPrimit, $origin->[0], $origin->[1], $origin->[2];
 194                         }
 195                 }
 196         }
 197         $outbuf .= UnparseEntity $ent, $brushes;
 198 }
 199
 200 close $infh;
 201
 202 open my $outfh, '>', $outfile
 203         or die ">$outfile: $!";
 204 print $outfh $outbuf;
 205 close $outfh;