half lambert lighting by jal (option: -lightanglehl)
[divverent/netradiant.git] / 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;