use Tk;
use Tk::FileSelect;
use Tk::DialogBox;

my $main = MainWindow->new(-title=>"DRS Extractor");

$main->Label(-width => 50, -text =>
"SWGB DRS Extractor/Recreator
version 0.6 (beta)
by Philip Taylor (philip\@zaynar.demon.co.uk)

This program is currently in a beta state, so
please let me know about any bugs you find!

Also, it may do weird things occasionally;
any unpleasant occurrences from the use of
this program are entirely your responsibility.
(and it looks ugly, but I can't be
bothered to provide a nice GUI) :-P
"
)->pack;

my $exButton = $main->Button(-text => "Extract files from DRS")->pack;
$exButton->configure(-command => sub{$exButton->configure(-state => "disabled");&GUIextract});
my $crButton = $main->Button(-text => "Create DRS from files")->pack;
$crButton->configure(-command => sub{$crButton->configure(-state => "disabled");&GUIglue});

MainLoop;

sub GUIextract {
  my $DRSFS = $main->FileSelect(-directory => '.');
  $DRSFS->configure(-filter => '*.drs|*.DRS', -dirlabel => 'Select the DRS file to be extracted from', -title => 'Select DRS file', -width => 25, height => 15);
  my $DRSFile = $DRSFS->Show;
  if ($DRSFile) {
    $DRSFile =~ /^(.*)\.drs$/i;
    my $directory = $1;
    if (!$directory) {
      $main->messageBox(-message => "Not a DRS file!", -title => "Error!", -type => "OK");
    } else {
      if ($main->messageBox(-message => "Preparing to extract $DRSFile into $directory/. It may take a number of seconds...", -type => 'OKCancel') eq "ok") {
        extract($DRSFile, $directory);
      }
    }
  }
  $exButton->configure(-state => "normal");
}

sub GUIglue {
  my $DRXFS = $main->FileSelect(-directory => '.');
  $DRXFS->configure(-filter => '*.drx|*.DRX', -dirlabel => 'Select the DRX file from which to recreate', -title => 'Select DRX file', -width => 25, height => 15);
  my $DRXFile = $DRXFS->Show;
  if ($DRXFile) {
    $DRXFile =~ m#^(.*)[\\/]([^\\/]*)[\\/]([^\\/]*)\.drx$#i;
    my $DRSFile = "$1/$3.drs";
    if (!$1) {
      $main->messageBox(-message => "Not a DRX file!", -title => "Error!", -type => "OK");
    } else {
      if ($main->messageBox(-message => "Preparing to recombine $DRXFile into $DRSFile (MAKE SURE YOU HAVE A BACKUP!) This may take a number of seconds...", -type => 'OKCancel') eq "ok") {
        glue($DRSFile, $DRXFile);
      }
    }
  }
  $crButton->configure(-state => "normal");
}


sub glue {
  my ($DRSFile, $DRXFile) = @_;

  $DRXFile =~ m#^(.*)[\\/].*\.drx#i;
  my $directory = $1;

  open DRS, ">$DRSFile" or do {
    $main->messageBox(-message => "Error creating $DRSFile: $!", -title => "Error", -type => "OK");
    return 1;
  };
  binmode DRS;

  open DRX, "<$DRXFile" or do {
    $main->messageBox(-message => "Error opening $DRXFile: $!", -title => "Error", -type => "OK");
    return 1;
  };

  my %drxTables;
  my $curTable='';
  my $totalFiles=0;
  while (my $line = <DRX>) {
    chomp $line;
    if ($line =~ /\[(.*)\]/) {
      $curTable = $1;
    } else {
      if (!-e "$directory/$line") {
        print "Cannot find file $directory/$line!\n";
        exit;
      }
      $drxTables{$curTable}{files} ||= [];
      push @{$drxTables{$curTable}{files}}, $line;
      ++$totalFiles;
    }
  }
  close DRX;

  my $drsHeader = "Copyright (c) 2001 LucasArts Entertainment Company LLC\x1A\0\0\0\0\0"."1.00"."swbg\0\0\0\0\0\0\0\0";
  my $drsNumTables = scalar keys %drxTables;

  my $finalHeaderSize = length($drsHeader) + 8 + 12*$drsNumTables;

  my $drsFirstOffset = $finalHeaderSize + $totalFiles*12;

  my $offset = $finalHeaderSize;
  my $drsTablesHeader;
  foreach my $resType (sort {(reverse $a) cmp (reverse $b)} keys %drxTables) {
    $drsTablesHeader .= $resType . pack("LL", $offset, $#{$drxTables{$resType}{files}}+1);
    $offset += ($#{$drxTables{$resType}{files}}+1)*12;
  }

  print DRS $drsHeader, pack("LL", $drsNumTables, $drsFirstOffset), $drsTablesHeader;

  $offset = $drsFirstOffset;

  foreach my $resType (sort {(reverse $a) cmp (reverse $b)} keys %drxTables) {
    foreach my $filename (@{$drxTables{$resType}{files}}) {
      $filename =~ /^(\d+)\./;
      my $fileID = $1;
      my $fileOffset = $offset;
      my $fileSize = (stat("$directory/$filename"))[7];
      $offset += $fileSize;
      print DRS pack("LLL", $fileID, $fileOffset, $fileSize);
    }
  }

  foreach my $resType (sort {(reverse $a) cmp (reverse $b)} keys %drxTables) {
    foreach my $filename (@{$drxTables{$resType}{files}}) {
      open FILE, "<$directory/$filename" or do {
        $main->messageBox(-message => "Error opening $directory/$filename: $!", -title => "Error", -type => "OK");
        return 1;
      };
      binmode FILE;
      my $buffer;
      print DRS $buffer while read FILE, $buffer, 1024;
      close FILE;
    }
  }
  
  close DRS;

  return 0;
}




sub extract {
  my ($DRSFile, $directory) = @_;
  my $drxLog = '';

  mkdir $directory, 0777 unless -d $directory;

  open DRS, "<$DRSFile" or do {
    $main->messageBox(-message => "Error opening $DRSFile: $!", -title => "Warning", -type => "OK");
    return 1;
  };
  binmode DRS;

  my ($copyright, $version, $filetype);
  read DRS, $copyright, 60;
  read DRS, $version, 4;
  read DRS, $filetype, 12;

  if ($copyright !~ /Copyright \(c\) 2001 LucasArts Entertainment Company LLC/ or
      $version ne '1.00' or
      $filetype !~ /swbg/) {
    if ($main->messageBox(-message => "Unrecognised file format. Continue anyway? (continuing may have undesirable effects)", -title => "Warning", -type => "OKCancel") ne "ok") {
      return 1;
    }
  }
  
  my ($numTables, $firstTableOffset);
  read DRS, $numTables, 4;
   $numTables = unpack("L", $numTables);
  read DRS, $firstTableOffset, 4;
   $firstTableOffset = unpack("L", $firstTableOffset);
  
  my @tables;
  
  for (0..$numTables-1) {
    my ($resType, $tableOffset, $numFiles);
    read DRS, $resType, 4;
    read DRS, $tableOffset, 4;
     $tableOffset = unpack("L", $tableOffset);
    read DRS, $numFiles, 4;
     $numFiles = unpack("L", $numFiles);
    push @tables, [$resType, $tableOffset, $numFiles];
  }
  
  my @files;
  foreach (@tables) {
    my ($resType, $tableOffset, $numFiles) = @$_;
    my $fileExtn = reverse(substr($resType, 1, 3));

    $drxLog .= "[$resType]\n";

    seek DRS, $tableOffset, 0;
    for (0..$numFiles-1) {
      my ($fileID, $fileOffset, $fileSize);
      read DRS, $fileID, 4;
       $fileID = unpack("L", $fileID);
      read DRS, $fileOffset, 4;
       $fileOffset = unpack("L", $fileOffset);
      read DRS, $fileSize, 4;
       $fileSize = unpack("L", $fileSize);
      push @files, [$fileExtn, $fileID, $fileOffset, $fileSize];

      $drxLog .= "$fileID.$fileExtn\n"

    }
  }
  
  foreach (@files) {
    my ($fileExtn, $fileID, $fileOffset, $fileSize) = @$_;
  
    seek DRS, $fileOffset, 0;
    my $fileData;
    read DRS, $fileData, $fileSize;
  
    open OUT, ">$directory/$fileID.$fileExtn" or do {
      $main->messageBox(-message => "Error creating $directory/$fileID.$fileExtn: $!", -title => "Error", -type => "OK");
      return 1;
    };
    binmode OUT;
    print OUT $fileData;
    close OUT;
  }
  
  close DRS;

  $DRSFile =~ m#([^\\/]*)\.drs$#i;
  my $DRXFile = "$directory/$1.drx";
  open DRX, ">$DRXFile" or do {
    $main->messageBox(-message => "Error creating $DRXFile: $!", -title => "Error", -type => "OK");
    return 1;
  };
  print DRX $drxLog;
  close DRX;

  return 0;
}