#!/usr/bin/perl -w

# strip a mission to make it smaller

use File::stat;
use Cowgen::Vbr;
use Cowgen::Gamfile;
use Cowgen::Bunch;
use strict 'vars';

# (c) Copyright by Tels 1999-2000. All Rights Reserved.

# This some things (namely the brush list and others) from a Thief level. Thus
# the file can be compressed better and is a bit smaller, although not as much
# as I hoped. 
# Another side effect is, that the file can no longer be loaded into DromEd. 
# This may be bad or good depending on your viewpoint.

# [09/20/99] v0.0.1
# [10/26/99] v0.0.2 - use new VBR stuff
# 2000-02-13 v0.0.3 - adjusted copyright, typos
# 2000-03-04 v0.0.4 - small fixes, strip empty properties/links, symnames
# 2000-03-06 v0.0.5 - symnames, fixed parameter parsing
# 2000-03-18 v0.0.6 - strip arbitray chunks by name
# 2000-04-26 v0.0.7 - delete rooms/brushes/lights/objects/areas/flows

my $VERSION = 0.07;

print "File stripper v$VERSION  (c) Copyright by Tels 1999-2000. All Rights Reserved.\n\n";
print " Usage:     perl strip [-flags] infile [outfile]\n";
print " Flags:     e            strip empty link and property chunks\n";
print "            sname,name2  strip chunks (no spaces!) by name (default: BRLIST)\n";
print "            d            delete all rooms/brushes/lights/objects/areas/flows\n";
print "                         by giving string of r,b,l,o,a and/or f\n";
print "            gGamfile     use Gamfile (necc. for -d, defaults to 'Dark.gam')\n";
print "            o            overwrite outfile if it exists\n\n";
print " Examples:  perl strip -eo -s Miss15.mis Stripped.mis\n";
print "            perl strip -e -sWR,AiPaTh,room_db Miss5.mis unportalized.mis -o\n";
print "            perl strip -dafolr -miss5.mis brushonly.mis\n";
print "            perl strip -dr -gdata/Thief2.gam miss5.mis norooms.mis\n\n";

my (%params,$vbr);
my ($p,@p);
$params{s} = [ ]; $params{e} = 0; $params{o} = 0;

my $files = get_commandline(\%params,@ARGV);
my $infile = $files->[0]; my $outfile = $files->[1];
# fix commandline parameter
$infile = "miss15.mis" if (!defined $infile);
$outfile = "stripped.mis" if (!defined $outfile); 
$infile .= ".mis" if (($infile !~ /\.mis$/) && (!-e $infile));

my ($chunk,@chunks,$stripped,$hr);
my $is = 20; # 20 bytes inventory entry size
my $all = 0;

print "Loading file $infile...\n";
$vbr = Cowgen::Vbr->create($infile); # suck in

# default
$params{g} = "Dark.gam" if (!defined $params{g});

my $things = { 
  r => 'rooms', a => 'areas', f => 'flows', o => 'objects', b => 'brushes', 
  l => 'lights' };

# deleting things
if (defined $params{d})
  {
  if ($params{d} ne "")
    {
    my @t = split //, $params{d};
    my %ti;
    foreach (@t) { $ti{$_} = 1; } # only once for each "lafobr"
    my $gf = Cowgen::Gamfile->create( $params{g} );
    my $bunch = Cowgen::Bunch->create( $infile, $vbr, $gf );
    print "Deleting all ";
    foreach (keys %ti)
      {
      print "$things->{$_}, "; $bunch->deleteAll ($things->{$_});
      }
    print "\b\b.\n";
    # now we need to force user to reportalize etc
    $vbr->delChunk('WR','AIPATH','ROOM_DB','AI_ROOM_DB');
    print "You need to reportalize the mission.\n";
    $bunch->stuff2vbr ( $vbr, $gf );
    }
  else
    {
    print "Error: No things to delete given after -d. Try again.\n";
    }
  }

if ($params{e} != 0)
  {
  $hr = $vbr->headerSize(); $stripped = $vbr->removeEmptyChunks();
  print "Removed $stripped empty property and link chunks (stripped ",
   $stripped*($hr+$is)," bytes).\n";
  $all += $stripped*($hr+$is);
  }

my $cn;
if (@{$params{s}} > 0)
  {
  foreach (@{$params{s}})
    {
    $cn = $vbr->findChunk($_);
    if (!defined $cn)
      {
      print "Huh!? File doesnt contain '$_' chunk! Cant strip that...\n";
      }
    else
      {
      $chunk = $vbr->getChunk($cn);
      $stripped = length($$chunk);
      print "Stripping $cn...";
      $vbr->delChunk($cn);          # yes, its that easily!
      $all += $stripped+$is; 
      print "stripped ",$stripped+$is," bytes.\n"; 
      }
    } # endfor all chunks to strip
  }

print "Saving to '$outfile'...stripped $all bytes at all.\n";
if (($params{o} == 0) && (-e $outfile))
  {
  print "Warning: '$outfile' exists. Use -o to overwrite it.\n";
  }
else
  {
  $vbr->writeFile($outfile);   # blow out
  }

print "Done.\n";

# EOF

1;

##########################################################################

sub get_commandline
  {
  # get commandline parameter(s), return in $params the params and as 
  # array the files
  my ($params,@ARGV) = @_;
  my $cmds = 'gd'; # switches with params (except s)
  my $files = []; 
  foreach (@ARGV)
    {
    if ($_ =~ /^\-/)
      {
      $_ =~ s/^\-//;
      if ($_ =~ /^s/)
        { 
        $params->{s} = $_; $params->{s} =~ s/^s//; 
        $params->{s} = "BRLIST" if ($params->{s} eq ""); # default
        $params->{s} = [ split /,/, $params->{s} ];
        }
      elsif ($cmds =~ substr($_,0,1))
        {
        $params->{substr($_,0,1)} = substr($_,1,length($_)-1) || "";
        }
      else
        {
        @p = split //,$_;
        foreach $p (@p) { $params->{$p} = 1; }
        }
      }
    else
      { 
      push (@$files, $_);
      }
    }
  $files;
  }