6 use POSIX qw/floor ceil/;
8 my @lumpname = qw/entities textures planes nodes leafs leaffaces leafbrushes models brushes brushsides vertices triangles effects faces lightmaps lightgrid pvs advertisements/;
28 my %lumpid = map { $lumpname[$_] => $_ } 0..@lumpname-1;
34 if(!@ARGV || $ARGV[0] eq '-h' || $ARGV[0] eq '--help')
38 $0 filename.bsp [operations...]
42 -i print info about the BSP file
43 -xlumpname extract a lump (see -i)
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)
58 -o actually apply the changes to the BSP
59 -ofilename2.bsp save the changes to a new BSP file
66 or die "invalid input file name (must be a .bsp): $fn";
71 read $fh, my $header, 8;
73 die "Invalid BSP format"
74 if $header ne "IBSP\x2e\x00\x00\x00";
78 read $fh, my $lump, 8;
79 my ($offset, $length) = unpack "VV", $lump;
81 push @bsp, [$offset, $length, undef];
86 my ($offset, $length, $data) = @$_;
88 read $fh, $data, $length;
89 length $data == $length
90 or die "Incomplete BSP lump at $offset\n";
100 my ($lump, @fields) = @_;
112 if(/^(\w*)=(.*?)(\d*)$/)
119 push @decoders, sub { ($item->{$f} = $data[$idx++]) =~ s/\0//g; };
123 push @decoders, sub { $item->{$f} = $data[$idx++]; };
127 push @decoders, sub { $item->{$f} = [ map { $data[$idx++] } 1..$n ]; };
132 my $itemlen = length pack $spec, ();
133 my $len = length $lump;
135 die "Invalid lump size: $len not divisible by $itemlen"
138 my $items = $len / $itemlen;
141 @data = unpack $spec, substr $lump, $_ * $itemlen, $itemlen;
144 $_->() for @decoders;
145 push @decoded, $item;
152 my ($items, @fields) = @_;
164 if(/^(\w*)=(.*?)(\d*)$/)
171 push @encoders, sub { $data .= pack $spec, $item->{$f}; };
175 push @encoders, sub { $data .= pack $spec, $item->{$f}; };
179 push @encoders, sub { $data .= pack $spec, @{$item->{$f}}; };
187 $_->() for @encoders;
193 sub EncodeDirection(@)
195 my ($x, $y, $z) = @_;
198 map { ($_ / 0.02454369260617025967) & 0xFF }
200 atan2(sqrt($x * $x + $y * $y), $z),
206 sub DecodeDirection($)
210 my ($pitch, $yaw) = map { $_ * 0.02454369260617025967 } @$dir; # maps 256 to 2pi
213 cos($yaw) * sin($pitch),
214 sin($yaw) * sin($pitch),
219 sub IntervalIntersection($$$$)
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"
230 return $right - $left;
233 sub BoxIntersection(@)
235 my ($x, $y, $z, $w, $h, $d, $x2, $y2, $z2, $w2, $h2, $d2) = @_;
237 IntervalIntersection($x, $w, $x2, $w2)
239 IntervalIntersection($y, $h, $y2, $h2)
241 IntervalIntersection($z, $d, $z2, $d2);
250 my $msgalign = [0, 3, 2, 1]->[length($msg) % 4];
251 my $total = 17 * 8 + 8 + length($msg) + $msgalign;
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;
266 print "BSP file size will change from $max to $total bytes\n";
268 elsif(/^-d(.+)$/) # delete a lump
270 my $id = $lumpid{$1};
271 die "invalid lump $1 to remove"
275 elsif(/^-r(.+)$/) # replace a lump
277 my $id = $lumpid{$1};
278 die "invalid lump $1 to replace"
280 $bsp[$id]->[2] = do { undef local $/; scalar <STDIN>; };
282 elsif(/^-m(.*)$/) # change the message
286 elsif(/^-l(jpg|png|tga)(\d+)?$/) # externalize lightmaps (deleting the internal ones)
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/;
298 my $l = $_->{lm_index};
299 next if $l >= 2**31; # signed
306 $lightmaps{$_+1} = $lightmaps{$_} for keys %lightmaps;
308 for(sort { $a <=> $b } keys %lightmaps)
310 print STDERR "Lightmap $_ was used $lightmaps{$_} times\n";
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, $_;
320 $img->Set(quality => $quality)
322 my $err = $img->Write($outfn);
325 print STDERR "Wrote $outfn\n";
328 # nullify the lightmap lump
329 $bsp[$lumpid{lightmaps}]->[2] = "";
331 elsif(/^-g(.+)$/) # export light grid as an image (for debugging)
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";
342 /^\s*"_?gridsize"\s+"(.*)"$/
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;
355 # sum up the "ambient" light over all pixels
358 for my $y(0..$isize[1]-1)
360 for my $x(0..$isize[0]-1)
362 my ($r, $g, $b) = (0, 0, 0);
363 for my $z(0..$isize[2]-1)
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];
370 push @pixels, [$r, $g, $b];
371 $max = $r if $max < $r;
372 $max = $g if $max < $g;
373 $max = $b if $max < $b;
379 $pixeldata .= pack "CCC", map { 255 * $p->[$_] / $max } 0..2;
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";
387 elsif(/^-G(.+)$/) # decimate light grid
390 my $filter = 1; # 0 = nearest, 1 = box filter
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)
400 my $l = $entitylines[$_];
402 if($l =~ /^\s*"_?gridsize"\s+"(.*)"$/)
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;
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;
426 my @newgridcells = ();
427 for my $z($newimins[2]..$newimaxs[2])
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])
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])
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];
454 my $innercell = $gridcells[($innerx - $imins[0]) + $isize[0] * ($innery - $imins[1]) + $isize[0] * $isize[1] * ($innerz - $imins[2])];
461 my $cell = $gridcells[($X - $imins[0]) + $isize[0] * ($Y - $imins[1]) + $isize[0] * $isize[1] * ($Z - $imins[2])];
463 my $cellweight = BoxIntersection(
465 map { $_ * $decimate } $x, $y, $z, 1, 1, 1
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;
478 $dir[$_] /= $weight for 0..2;
479 $dir[$_] *= $filter for 0..2;
480 $dir[$_] += (1 - $filter) * $innercell->{directional}->[$_] for 0..2;
482 $amb[$_] /= $weight for 0..2;
483 $amb[$_] *= $filter for 0..2;
484 $amb[$_] += (1 - $filter) * $innercell->{ambient}->[$_] for 0..2;
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;
493 directional => \@dir,
494 dir => EncodeDirection @norm
498 push @newgridcells, $innercell;
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;
510 elsif(/^-x(.+)$/) # extract lump to stdout
512 my $id = $lumpid{$1};
513 die "invalid lump $1 to extract"
515 print $bsp[$id]->[2];
517 elsif(/^-S(.*)=(.*)$/)
522 my @l = DecodeLump $bsp[$lumpid{textures}]->[2], qw/name=a64 flags=V contents=V/;
525 next if $replaced[$_];
526 if($l[$_]->{name} eq $from)
529 $l[$_]->{name} = $to;
532 $bsp[$lumpid{textures}]->[2] = EncodeLump \@l, qw/name=a64 flags=V contents=V/;
536 for(DecodeLump $bsp[$lumpid{textures}]->[2], qw/name=a64 flags=V contents=V/)
538 print "$_->{name}\n";
541 elsif(/^-o(.+)?$/) # write the final BSP file
545 if not defined $outfile;
546 open my $fh, ">", $outfile
547 or die "$outfile: $!";
549 my $msgalign = [0, 3, 2, 1]->[length($msg) % 4];
550 my $pos = 17 * 8 + tell($fh) + length($msg) + $msgalign;
553 my $align = [0, 3, 2, 1]->[length($_->[2]) % 4];
555 $_->[1] = length $_->[2];
556 $pos += $_->[1] + $align;
557 print $fh pack "VV", $_->[0], $_->[1];
560 print $fh "\x00" x $msgalign;
563 my $align = [0, 3, 2, 1]->[length($_->[2]) % 4];
565 print $fh "\x00" x $align;
568 print STDERR "Wrote $outfile\n";
572 die "Invalid option: $_";
578 # decimate light grid
579 # edit lightmaps/grid