misc/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 %lumpid = map { $lumpname[$_] => $_ } 0..@lumpname-1;
  10 my $msg = "";
  11 my @bsp;
  12
  13 # READ THE BSP
  14
  15 my $fn = shift @ARGV;
  16 $fn =~ /(.*)\.bsp$/
  17         or die "invalid input file name (must be a .bsp): $fn";
  18 my $basename = $1;
  19 open my $fh, "<", $fn
  20         or die "$fn: $!";
  21
  22 read $fh, my $header, 8;
  23
  24 die "Invalid BSP format"
  25         if $header ne "IBSP\x2e\x00\x00\x00";
  26
  27 for(0..16)
  28 {
  29         read $fh, my $lump, 8;
  30         my ($offset, $length) = unpack "VV", $lump;
  31
  32         print STDERR "BSP lump $_ ($lumpname[$_]): offset $offset length $length\n";
  33         push @bsp, [$offset, $length, undef];
  34 }
  35
  36 for(@bsp)
  37 {
  38         my ($offset, $length, $data) = @$_;
  39         seek $fh, $offset, 0;
  40         read $fh, $data, $length;
  41         length $data == $length
  42                 or die "Incomplete BSP lump at $offset\n";
  43         $_->[2] = $data;
  44 }
  45
  46 close $fh;
  47
  48 # STRUCT DECODING
  49
  50 sub DecodeLump($@)
  51 {
  52         my ($lump, @fields) = @_;
  53         my @decoded;
  54
  55         my $spec = "";
  56         my @decoders;
  57
  58         my $item;
  59         my @data;
  60         my $idx;
  61
  62         for(@fields)
  63         {
  64                 if(/^(\w*)=(.*?)(\d*)$/)
  65                 {
  66                         $spec .= "$2$3 ";
  67                         my $f = $1;
  68                         my $n = $3;
  69                         if($n eq '')
  70                         {
  71                                 push @decoders, sub { $item->{$f} = $data[$idx++]; };
  72                         }
  73                         else
  74                         {
  75                                 push @decoders, sub { $item->{$f} = [ map { $data[$idx++] } 1..$n ]; };
  76                         }
  77                 }
  78         }
  79
  80         my $itemlen = length pack $spec, ();
  81         my $len = length $lump;
  82
  83         die "Invalid lump size: $len not divisible by $itemlen"
  84                 if $len % $itemlen;
  85
  86         my $items = $len / $itemlen;
  87         for(0..$items - 1)
  88         {
  89                 @data = unpack $spec, substr $lump, $_ * $itemlen, $itemlen;
  90                 $item = {};
  91                 $idx = 0;
  92                 $_->() for @decoders;
  93                 push @decoded, $item;
  94         }
  95         @decoded;
  96 }
  97
  98 # OPTIONS
  99
 100 for(@ARGV)
 101 {
 102         if(/^-d(.+)$/) # delete a lump
 103         {
 104                 my $id = $lumpid{$1};
 105                 die "invalid lump $1 to remove"
 106                         unless defined $id;
 107                 $bsp[$id]->[2] = "";
 108         }
 109         elsif(/^-m(.*)$/) # change the message
 110         {
 111                 $msg = $1;
 112         }
 113         elsif(/^-l(jpg|png|tga)(\d+)?$/) # externalize lightmaps (deleting the internal ones)
 114         {
 115                 my $ext = $1;
 116                 my $quality = $2;
 117                 my %lightmaps = ();
 118                 my $faces = $bsp[$lumpid{faces}]->[2];
 119                 my $lightmaps = $bsp[$lumpid{lightmaps}]->[2];
 120                 my @values = DecodeLump $faces,
 121                         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/;
 122                 my $oddfound = 0;
 123                 for(@values)
 124                 {
 125                         my $l = $_->{lm_index};
 126                         next if $l >= 2**31; # signed
 127                         $oddfound = 1
 128                                 if $l % 2;
 129                         ++$lightmaps{$l};
 130                 }
 131                 if(!$oddfound)
 132                 {
 133                         $lightmaps{$_+1} = $lightmaps{$_} for keys %lightmaps;
 134                 }
 135                 for(sort { $a <=> $b } keys %lightmaps)
 136                 {
 137                         print STDERR "Lightmap $_ was used $lightmaps{$_} times\n";
 138
 139                         # export that lightmap
 140                         my $lmsize = 128 * 128 * 3;
 141                         next if length $lightmaps < ($_ + 1) * $lmsize;
 142                         my $lmdata = substr $lightmaps, $_ * $lmsize, $lmsize;
 143                         my $img = Image::Magick->new(size => '128x128', depth => 8, magick => 'RGB');
 144                         $img->BlobToImage($lmdata);
 145                         my $outfn = sprintf "%s/lm_%04d.$ext", $basename, $_;
 146                         mkdir $basename;
 147                         $img->Set(quality => $quality)
 148                                 if defined $quality;
 149                         my $err = $img->Write($outfn);
 150                         die $err
 151                                 if $err;
 152                         print STDERR "Wrote $outfn\n";
 153                 }
 154
 155                 # nullify the lightmap lump
 156                 $bsp[$lumpid{lightmaps}]->[2] = "";
 157         }
 158         elsif(/^-g$/) # decimate light grid
 159         {
 160                 my @models = DecodeLump $bsp[$lumpid{models}]->[2],
 161                         qw/mins=f3 maxs=f3 face=V n_faces=V brush=V n_brushes=V/;
 162                 my $entities = $bsp[$lumpid{entities}]->[2];
 163                 my @entitylines = split /\r?\n/, $entities;
 164                 my $gridsize = "64 64 128";
 165                 for(@entitylines)
 166                 {
 167                         last if $_ eq '}';
 168                         /^\s*"gridsize"\s+"(.*)"$/
 169                                 and $gridsize = $1;
 170                 }
 171                 my @scale = map { 1 / $_ } split / /, $gridsize;
 172                 my @imins = map { ceil($models[0]{mins}[$_] * $scale[$_]) } 0..2;
 173                 my @imaxs = map { floor($models[0]{maxs}[$_] * $scale[$_]) } 0..2;
 174                 my @isize = map { $imaxs[$_] - $imins[$_] + 1 } 0..2;
 175                 my $isize = $isize[0] * $isize[1] * $isize[2];
 176                 my @gridcells = DecodeLump $bsp[$lumpid{lightgrid}]->[2],
 177                         qw/ambient=C3 directional=C3 dir=C2/;
 178                 die "Cannot decode light grid"
 179                         unless $isize == @gridcells;
 180
 181                 # TODO now decimate it and reinsert the lump (and the changed entity lump for the new size)
 182         }
 183         elsif(/^-x(.+)$/) # extract lump to stdout
 184         {
 185                 my $id = $lumpid{$1};
 186                 die "invalid lump $1 to extract"
 187                         unless defined $id;
 188                 print $bsp[$id]->[2];
 189         }
 190         elsif(/^-o(.+)?$/) # write the final BSP file
 191         {
 192                 my $outfile = $1;
 193                 $outfile = $fn
 194                         if not defined $outfile;
 195                 open my $fh, ">", $outfile
 196                         or die "$outfile: $!";
 197                 print $fh $header;
 198                 my $pos = 17 * 8 + tell($fh) + length $msg;
 199                 for(@bsp)
 200                 {
 201                         $_->[0] = $pos;
 202                         $_->[1] = length $_->[2];
 203                         $pos += $_->[1];
 204                         print $fh pack "VV", $_->[0], $_->[1];
 205                 }
 206                 print $fh $msg;
 207                 for(@bsp)
 208                 {
 209                         print $fh $_->[2];
 210                 }
 211                 close $fh;
 212                 print STDERR "Wrote $outfile\n";
 213         }
 214         else
 215         {
 216                 die "Invalid option: $_";
 217         }
 218 }
 219
 220 # TODO:
 221 #   features like:
 222 #     decimate light grid
 223 #     edit lightmaps/grid