]> git.xonotic.org Git - xonotic/xonotic.git/blob - misc/tools/bsptool.pl
Since compile options are found in the maps pk3, no need for outdated compile settings.
[xonotic/xonotic.git] / misc / tools / bsptool.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use Image::Magick;
6 use POSIX qw/floor ceil/;
7
8 my @lumpname = qw/entities textures planes nodes leafs leaffaces leafbrushes models brushes brushsides vertices triangles effects faces lightmaps lightgrid pvs advertisements/;
9 my %lumpsize = (
10         textures => 72,
11         planes => 16,
12         nodes => 36,
13         leafs => 48,
14         leaffaces => 4,
15         leafbrushes => 4,
16         models => 40,
17         brushes => 12,
18         brushsides => 8,
19         vertices => 44,
20         triangles => 4,
21         effects => 72,
22         faces => 104,
23         lightmaps => 49152,
24         lightgrid => 8,
25         advertisements => 128
26 );
27
28 my %lumpid = map { $lumpname[$_] => $_ } 0..@lumpname-1;
29 my $msg = "";
30 my @bsp;
31
32 # READ THE BSP
33
34 if(!@ARGV || $ARGV[0] eq '-h' || $ARGV[0] eq '--help')
35 {
36         print <<EOF;
37 Usage:
38   $0 filename.bsp [operations...]
39
40 Operations are:
41   Information requests:
42     -i                print info about the BSP file
43     -xlumpname        extract a lump (see -i)
44     -S                list used shaders
45
46   Changes:
47     -dlumpname        delete a lump (see -i)
48     -rlumpname        replace a lump (see -i) by the data from standard input
49     -gfilename.tga    save the lightgrid as filename.tga (debugging)
50     -Gratio           scale down the lightgrid to reduce BSP file size
51     -ljpgNNN          externalize the lightmaps as JPEG, quality NNN (number from 1 to 100)
52     -lpng             externalize the lightmaps as PNG
53     -ltga             externalize the lightmaps as TGA
54     -mMESSAGE         set the BSP file comment message
55     -Sfrom=to         replace a texture (shader) by name (already replaced shaders are not touched)
56
57   Save commands:
58     -o                actually apply the changes to the BSP
59     -ofilename2.bsp   save the changes to a new BSP file
60 EOF
61         exit;
62 }
63
64 my $fn = shift @ARGV;
65 $fn =~ /(.*)\.bsp$/
66         or die "invalid input file name (must be a .bsp): $fn";
67 my $basename = $1;
68 open my $fh, "<", $fn
69         or die "$fn: $!";
70
71 read $fh, my $header, 8;
72
73 die "Invalid BSP format"
74         if $header ne "IBSP\x2e\x00\x00\x00";
75
76 for(0..16)
77 {
78         read $fh, my $lump, 8;
79         my ($offset, $length) = unpack "VV", $lump;
80
81         push @bsp, [$offset, $length, undef];
82 }
83
84 for(@bsp)
85 {
86         my ($offset, $length, $data) = @$_;
87         seek $fh, $offset, 0;
88         read $fh, $data, $length;
89         length $data == $length
90                 or die "Incomplete BSP lump at $offset\n";
91         $_->[2] = $data;
92 }
93
94 close $fh;
95
96 # STRUCT DECODING
97
98 sub DecodeLump($@)
99 {
100         my ($lump, @fields) = @_;
101         my @decoded;
102
103         my $spec = "";
104         my @decoders;
105
106         my $item;
107         my @data;
108         my $idx;
109
110         for(@fields)
111         {
112                 if(/^(\w*)=(.*?)(\d*)$/)
113                 {
114                         $spec .= "$2$3 ";
115                         my $f = $1;
116                         my $n = $3;
117                         if($2 eq 'a')
118                         {
119                                 push @decoders, sub { ($item->{$f} = $data[$idx++]) =~ s/\0//g; };
120                         }
121                         elsif($n eq '')
122                         {
123                                 push @decoders, sub { $item->{$f} = $data[$idx++]; };
124                         }
125                         else
126                         {
127                                 push @decoders, sub { $item->{$f} = [ map { $data[$idx++] } 1..$n ]; };
128                         }
129                 }
130         }
131
132         my $itemlen = length pack $spec, ();
133         my $len = length $lump;
134
135         die "Invalid lump size: $len not divisible by $itemlen"
136                 if $len % $itemlen;
137
138         my $items = $len / $itemlen;
139         for(0..$items - 1)
140         {
141                 @data = unpack $spec, substr $lump, $_ * $itemlen, $itemlen;
142                 $item = {};
143                 $idx = 0;
144                 $_->() for @decoders;
145                 push @decoded, $item;
146         }
147         @decoded;
148 }
149
150 sub EncodeLump($@)
151 {
152         my ($items, @fields) = @_;
153         my @decoded;
154
155         my @encoders;
156
157         my $item;
158         my @data;
159         my $idx;
160         my $data = "";
161
162         for(@fields)
163         {
164                 if(/^(\w*)=(.*?)(\d*)$/)
165                 {
166                         my $spec = "$2$3";
167                         my $f = $1;
168                         my $n = $3;
169                         if($2 eq 'a')
170                         {
171                                 push @encoders, sub { $data .= pack $spec, $item->{$f}; };
172                         }
173                         elsif($n eq '')
174                         {
175                                 push @encoders, sub { $data .= pack $spec, $item->{$f}; };
176                         }
177                         else
178                         {
179                                 push @encoders, sub { $data .= pack $spec, @{$item->{$f}}; };
180                         }
181                 }
182         }
183
184         for my $i(@$items)
185         {
186                 $item = $i;
187                 $_->() for @encoders;
188         }
189
190         $data;
191 }
192
193 sub EncodeDirection(@)
194 {
195         my ($x, $y, $z) = @_;
196
197         return [
198                 map { ($_ / 0.02454369260617025967) & 0xFF }
199                 (
200                         atan2(sqrt($x * $x + $y * $y), $z),
201                         atan2($y, $x)
202                 )
203         ];
204 }
205
206 sub DecodeDirection($)
207 {
208         my ($dir) = @_;
209
210         my ($pitch, $yaw) = map { $_ * 0.02454369260617025967 } @$dir; # maps 256 to 2pi
211
212         return (
213                 cos($yaw) * sin($pitch),
214                 sin($yaw) * sin($pitch),
215                 cos($pitch)
216         );
217 }
218
219 sub IntervalIntersection($$$$)
220 {
221         my ($a, $al, $b, $bl) = @_;
222         my $a0 = $a - 0.5 * $al;
223         my $a1 = $a + 0.5 * $al;
224         my $b0 = $b - 0.5 * $bl;
225         my $b1 = $b + 0.5 * $bl;
226         my $left = ($a0 > $b0) ? $a0 : $b0;
227         my $right = ($a1 > $b1) ? $b1 : $a1;
228         die "Non-intersecting intervals $a $al $b $bl"
229                 if $right < $left;
230         return $right - $left;
231 }
232
233 sub BoxIntersection(@)
234 {
235         my ($x, $y, $z, $w, $h, $d, $x2, $y2, $z2, $w2, $h2, $d2) = @_;
236         return
237                 IntervalIntersection($x, $w, $x2, $w2)
238                 *
239                 IntervalIntersection($y, $h, $y2, $h2)
240                 *
241                 IntervalIntersection($z, $d, $z2, $d2);
242 }
243
244 # OPTIONS
245
246 for(@ARGV)
247 {
248         if(/^-i$/) # info
249         {
250                 my $msgalign = [0, 3, 2, 1]->[length($msg) % 4];
251                 my $total = 17 * 8 + 8 + length($msg) + $msgalign;
252                 my $max = 0;
253                 for(0..@bsp-1)
254                 {
255                         my $nl = length $bsp[$_]->[2];
256                         my $align = [0, 3, 2, 1]->[$nl % 4];
257                         $total += $nl + $align;
258                         my $l = $bsp[$_]->[1];
259                         my $szi = $lumpsize{$lumpname[$_]};
260                         my $li = $szi ? " (" . ($l / $szi) . ")" : "";
261                         my $nli = $szi ? " (" . ($nl / $szi) . ")" : "";
262                         print "BSP lump $_ ($lumpname[$_]): offset $bsp[$_]->[0] length $l$li newlength $nl$nli\n";
263                         my $endpos = $bsp[$_]->[0] + $bsp[$_]->[1];
264                         $max = $endpos if $max < $endpos;
265                 }
266                 print "BSP file size will change from $max to $total bytes\n";
267         }
268         elsif(/^-d(.+)$/) # delete a lump
269         {
270                 my $id = $lumpid{$1};
271                 die "invalid lump $1 to remove"
272                         unless defined $id;
273                 $bsp[$id]->[2] = "";
274         }
275         elsif(/^-r(.+)$/) # replace a lump
276         {
277                 my $id = $lumpid{$1};
278                 die "invalid lump $1 to replace"
279                         unless defined $id;
280                 $bsp[$id]->[2] = do { undef local $/; scalar <STDIN>; };
281         }
282         elsif(/^-m(.*)$/) # change the message
283         {
284                 $msg = $1;
285         }
286         elsif(/^-l(jpg|png|tga)(\d+)?$/) # externalize lightmaps (deleting the internal ones)
287         {
288                 my $ext = $1;
289                 my $quality = $2;
290                 my %lightmaps = ();
291                 my $faces = $bsp[$lumpid{faces}]->[2];
292                 my $lightmaps = $bsp[$lumpid{lightmaps}]->[2];
293                 my @values = DecodeLump $faces,
294                         qw/texture=V effect=V type=V vertex=V n_vertexes=V meshvert=V n_meshverts=V lm_index=V lm_start=f2 lm_size=f2 lm_origin=f3 lm_vec_0=f3 lm_vec_1=f3 normal=f3 size=V2/;
295                 my $oddfound = 0;
296                 for(@values)
297                 {
298                         my $l = $_->{lm_index};
299                         next if $l >= 2**31; # signed
300                         $oddfound = 1
301                                 if $l % 2;
302                         ++$lightmaps{$l};
303                 }
304                 if(!$oddfound)
305                 {
306                         $lightmaps{$_+1} = $lightmaps{$_} for keys %lightmaps;
307                 }
308                 for(sort { $a <=> $b } keys %lightmaps)
309                 {
310                         print STDERR "Lightmap $_ was used $lightmaps{$_} times\n";
311
312                         # export that lightmap
313                         my $lmsize = 128 * 128 * 3;
314                         next if length $lightmaps < ($_ + 1) * $lmsize;
315                         my $lmdata = substr $lightmaps, $_ * $lmsize, $lmsize;
316                         my $img = Image::Magick->new(size => '128x128', depth => 8, magick => 'RGB');
317                         $img->BlobToImage($lmdata);
318                         my $outfn = sprintf "%s/lm_%04d.$ext", $basename, $_;
319                         mkdir $basename;
320                         $img->Set(quality => $quality)
321                                 if defined $quality;
322                         my $err = $img->Write($outfn);
323                         die $err
324                                 if $err;
325                         print STDERR "Wrote $outfn\n";
326                 }
327
328                 # nullify the lightmap lump
329                 $bsp[$lumpid{lightmaps}]->[2] = "";
330         }
331         elsif(/^-g(.+)$/) # export light grid as an image (for debugging)
332         {
333                 my $filename = $1;
334                 my @models = DecodeLump $bsp[$lumpid{models}]->[2],
335                         qw/mins=f3 maxs=f3 face=V n_faces=V brush=V n_brushes=V/;
336                 my $entities = $bsp[$lumpid{entities}]->[2];
337                 my @entitylines = split /\r?\n/, $entities;
338                 my $gridsize = "64 64 128";
339                 for(@entitylines)
340                 {
341                         last if $_ eq '}';
342                         /^\s*"_?gridsize"\s+"(.*)"$/
343                                 and $gridsize = $1;
344                 }
345                 my @scale = map { 1 / $_ } split / /, $gridsize;
346                 my @imins = map { ceil($models[0]{mins}[$_] * $scale[$_]) } 0..2;
347                 my @imaxs = map { floor($models[0]{maxs}[$_] * $scale[$_]) } 0..2;
348                 my @isize = map { $imaxs[$_] - $imins[$_] + 1 } 0..2;
349                 my $isize = $isize[0] * $isize[1] * $isize[2];
350                 my @gridcells = DecodeLump $bsp[$lumpid{lightgrid}]->[2],
351                         qw/ambient=C3 directional=C3 dir=C2/;
352                 die "Cannot decode light grid"
353                         unless $isize == @gridcells;
354
355                 # sum up the "ambient" light over all pixels
356                 my @pixels;
357                 my $max = 1;
358                 for my $y(0..$isize[1]-1)
359                 {
360                         for my $x(0..$isize[0]-1)
361                         {
362                                 my ($r, $g, $b) = (0, 0, 0);
363                                 for my $z(0..$isize[2]-1)
364                                 {
365                                         my $cell = $gridcells[$x + $y * $isize[0] + $z * $isize[0] * $isize[1]];
366                                         $r += $cell->{ambient}->[0];
367                                         $g += $cell->{ambient}->[1];
368                                         $b += $cell->{ambient}->[2];
369                                 }
370                                 push @pixels, [$r, $g, $b];
371                                 $max = $r if $max < $r;
372                                 $max = $g if $max < $g;
373                                 $max = $b if $max < $b;
374                         }
375                 }
376                 my $pixeldata = "";
377                 for my $p(@pixels)
378                 {
379                         $pixeldata .= pack "CCC", map { 255 * $p->[$_] / $max } 0..2;
380                 }
381
382                 my $img = Image::Magick->new(size => sprintf("%dx%d", $isize[0], $isize[1]), depth => 8, magick => 'RGB');
383                 $img->BlobToImage($pixeldata);
384                 $img->Write($filename);
385                 print STDERR "Wrote $filename\n";
386         }
387         elsif(/^-G(.+)$/) # decimate light grid
388         {
389                 my $decimate = $1;
390                 my $filter = 1; # 0 = nearest, 1 = box filter
391
392                 my @models = DecodeLump $bsp[$lumpid{models}]->[2],
393                         qw/mins=f3 maxs=f3 face=V n_faces=V brush=V n_brushes=V/;
394                 my $entities = $bsp[$lumpid{entities}]->[2];
395                 my @entitylines = split /\r?\n/, $entities;
396                 my $gridsize = "64 64 128";
397                 my $gridsizeindex = undef;
398                 for(0..@entitylines-1)
399                 {
400                         my $l = $entitylines[$_];
401                         last if $l eq '}';
402                         if($l =~ /^\s*"_?gridsize"\s+"(.*)"$/)
403                         {
404                                 $gridsize = $1;
405                                 $gridsizeindex = $_;
406                         }
407                 }
408                 my @scale = map { 1 / $_ } split / /, $gridsize;
409                 my @imins = map { ceil($models[0]{mins}[$_] * $scale[$_]) } 0..2;
410                 my @imaxs = map { floor($models[0]{maxs}[$_] * $scale[$_]) } 0..2;
411                 my @isize = map { $imaxs[$_] - $imins[$_] + 1 } 0..2;
412                 my $isize = $isize[0] * $isize[1] * $isize[2];
413                 my @gridcells = DecodeLump $bsp[$lumpid{lightgrid}]->[2],
414                         qw/ambient=C3 directional=C3 dir=C2/;
415                 die "Cannot decode light grid"
416                         unless $isize == @gridcells;
417
418                 # get the new grid size values
419                 my @newscale = map { $_ / $decimate } @scale;
420                 my $newgridsize = join " ", map { 1 / $_ } @newscale;
421                 my @newimins = map { ceil($models[0]{mins}[$_] * $newscale[$_]) } 0..2;
422                 my @newimaxs = map { floor($models[0]{maxs}[$_] * $newscale[$_]) } 0..2;
423                 my @newisize = map { $newimaxs[$_] - $newimins[$_] + 1 } 0..2;
424
425                 # do the decimation
426                 my @newgridcells = ();
427                 for my $z($newimins[2]..$newimaxs[2])
428                 {
429                         # the coords are MIDPOINTS of the grid cells!
430                         my @oldz = grep { $_ >= $imins[2] && $_ <= $imaxs[2] } floor(($z - 0.5) * $decimate + 0.5) .. ceil(($z + 0.5) * $decimate - 0.5);
431                         my $innerz_raw = $z * $decimate;
432                         my $innerz = floor($innerz_raw + 0.5);
433                         $innerz = $imins[2] if $innerz < $imins[2];
434                         $innerz = $imaxs[2] if $innerz > $imaxs[2];
435                         for my $y($newimins[1]..$newimaxs[1])
436                         {
437                                 my @oldy = grep { $_ >= $imins[1] && $_ <= $imaxs[1] } floor(($y - 0.5) * $decimate + 0.5) .. ceil(($y + 0.5) * $decimate - 0.5);
438                                 my $innery_raw = $y * $decimate;
439                                 my $innery = floor($innery_raw + 0.5);
440                                 $innery = $imins[1] if $innery < $imins[1];
441                                 $innery = $imaxs[1] if $innery > $imaxs[1];
442                                 for my $x($newimins[0]..$newimaxs[0])
443                                 {
444                                         my @oldx = grep { $_ >= $imins[0] && $_ <= $imaxs[0] } floor(($x - 0.5) * $decimate + 0.5) .. ceil(($x + 0.5) * $decimate - 0.5);
445                                         my $innerx_raw = $x * $decimate;
446                                         my $innerx = floor($innerx_raw + 0.5);
447                                         $innerx = $imins[0] if $innerx < $imins[0];
448                                         $innerx = $imaxs[0] if $innerx > $imaxs[0];
449
450                                         my @vec = (0, 0, 0);
451                                         my @dir = (0, 0, 0);
452                                         my @amb = (0, 0, 0);
453                                         my $weight = 0;
454                                         my $innercell = $gridcells[($innerx - $imins[0]) + $isize[0] * ($innery - $imins[1]) + $isize[0] * $isize[1] * ($innerz - $imins[2])];
455                                         for my $Z(@oldz)
456                                         {
457                                                 for my $Y(@oldy)
458                                                 {
459                                                         for my $X(@oldx)
460                                                         {
461                                                                 my $cell = $gridcells[($X - $imins[0]) + $isize[0] * ($Y - $imins[1]) + $isize[0] * $isize[1] * ($Z - $imins[2])];
462
463                                                                 my $cellweight = BoxIntersection(
464                                                                         $X, $Y, $Z, 1, 1, 1,
465                                                                         map { $_ * $decimate } $x, $y, $z, 1, 1, 1
466                                                                 );
467
468                                                                 $dir[$_] += $cellweight * $cell->{directional}->[$_] for 0..2;
469                                                                 $amb[$_] += $cellweight * $cell->{ambient}->[$_] for 0..2;
470                                                                 my @norm = DecodeDirection $cell->{dir};
471                                                                 $vec[$_] += $cellweight * $norm[$_] for 0..2;
472                                                                 $weight += $cellweight;
473                                                         }
474                                                 }
475                                         }
476                                         if($weight)
477                                         {
478                                                 $dir[$_] /= $weight for 0..2;
479                                                 $dir[$_] *= $filter for 0..2;
480                                                 $dir[$_] += (1 - $filter) * $innercell->{directional}->[$_] for 0..2;
481
482                                                 $amb[$_] /= $weight for 0..2;
483                                                 $amb[$_] *= $filter for 0..2;
484                                                 $amb[$_] += (1 - $filter) * $innercell->{ambient}->[$_] for 0..2;
485
486                                                 my @norm = DecodeDirection $innercell->{dir};
487                                                 $vec[$_] /= $weight for 0..2;
488                                                 $vec[$_] *= $filter for 0..2;
489                                                 $vec[$_] += (1 - $filter) * $norm[$_] for 0..2;
490
491                                                 $innercell = {
492                                                         ambient => \@amb,
493                                                         directional => \@dir,
494                                                         dir => EncodeDirection @norm
495                                                 };
496                                         }
497
498                                         push @newgridcells, $innercell;
499                                 }
500                         }
501                 }
502
503                 $bsp[$lumpid{lightgrid}]->[2] = EncodeLump \@newgridcells,
504                         qw/ambient=C3 directional=C3 dir=C2/;
505                 splice @entitylines, $gridsizeindex, 1, ()
506                         if defined $gridsizeindex;
507                 splice @entitylines, 1, 0, qq{"gridsize" "$newgridsize"};
508                 $bsp[$lumpid{entities}]->[2] = join "\n", @entitylines;
509         }
510         elsif(/^-x(.+)$/) # extract lump to stdout
511         {
512                 my $id = $lumpid{$1};
513                 die "invalid lump $1 to extract"
514                         unless defined $id;
515                 print $bsp[$id]->[2];
516         }
517         elsif(/^-S(.*)=(.*)$/)
518         {
519                 my $from = $1;
520                 my $to = $2;
521                 our @replaced = ();
522                 my @l = DecodeLump $bsp[$lumpid{textures}]->[2], qw/name=a64 flags=V contents=V/;
523                 for(0..@l-1)
524                 {
525                         next if $replaced[$_];
526                         if($l[$_]->{name} eq $from)
527                         {
528                                 $replaced[$_] = 1;
529                                 $l[$_]->{name} = $to;
530                         }
531                 }
532                 $bsp[$lumpid{textures}]->[2] = EncodeLump \@l, qw/name=a64 flags=V contents=V/;
533         }
534         elsif(/^-S$/)
535         {
536                 for(DecodeLump $bsp[$lumpid{textures}]->[2], qw/name=a64 flags=V contents=V/)
537                 {
538                         print "$_->{name}\n";
539                 }
540         }
541         elsif(/^-o(.+)?$/) # write the final BSP file
542         {
543                 my $outfile = $1;
544                 $outfile = $fn
545                         if not defined $outfile;
546                 open my $fh, ">", $outfile
547                         or die "$outfile: $!";
548                 print $fh $header;
549                 my $msgalign = [0, 3, 2, 1]->[length($msg) % 4];
550                 my $pos = 17 * 8 + tell($fh) + length($msg) + $msgalign;
551                 for(@bsp)
552                 {
553                         my $align = [0, 3, 2, 1]->[length($_->[2]) % 4];
554                         $_->[0] = $pos;
555                         $_->[1] = length $_->[2];
556                         $pos += $_->[1] + $align;
557                         print $fh pack "VV", $_->[0], $_->[1];
558                 }
559                 print $fh $msg;
560                 print $fh "\x00" x $msgalign;
561                 for(@bsp)
562                 {
563                         my $align = [0, 3, 2, 1]->[length($_->[2]) % 4];
564                         print $fh $_->[2];
565                         print $fh "\x00" x $align;
566                 }
567                 close $fh;
568                 print STDERR "Wrote $outfile\n";
569         }
570         else
571         {
572                 die "Invalid option: $_";
573         }
574 }
575
576 # TODO:
577 #   features like:
578 #     decimate light grid
579 #     edit lightmaps/grid