#!/usr/bin/perl -w
use strict;

# Blorbster - a blorb-creator based on Evin Robertson's blorbtar
# Copyright 2001 Adam Thornton
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  See http://www.gnu.org/copyleft/gpl.html for the terms of the
#  GNU General Public License.  If you don't have internet access, write to
#  the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
#  Boston, MA 02111, USA.
#
#  The author can be reached at adam@fsf.net

# Usage: blorbster resource-file
#
# Resource file is as defined in L. Ross Raszewski's front.txt
#  
# It's basically a subset of Nelson's "blurb" format.
#
# Resource records are
# CODE                 file (Zcode or Glulx)
# COPYRIGHT Text
# AUTHOR    Text
# NOTE      Text
# RELEASE   Number
# PICTURE   ResourceID file
# SOUND     ResourceID file
# PALETTE              file (blorb palette format)
# RESOLUTION           file (blorb resolution format)
# HIGHCOLOR                 (16-bit palette)
# TRUECOLOR                 (32-bit palette)
# ! Comment

# This program takes a resource file and generates an appropriate blorb
#  file with contents as specified in the resource file.
# The HIGHCOLOR and TRUECOLOR palette directives are not implemented
# This code is almost entirely due to Evin Robertson; all that is original 
#  is the resource file parser.


         # base filename => [ Usage, Chunk type ]
my %namelist = ( PIC     => [ "Pict", \&PicType ],
		 SND     => [ "Snd ", \&SndType ],
		 STORY   => [ "Exec", \&GamType ],
		 PALETTE => [ 0, "Plte" ],
		 RESOL   => [ 0, "Reso" ],
		 LOOPING => [ 0, "Loop" ],
		 RELEASE => [ 0, "RelN" ],
		 IDENT   => [ 0, "IFhd" ],
		 COPY    => [ 0, "(c) " ],
		 AUTH    => [ 0, "AUTH" ],
		 ANNO    => [ 0, "ANNO" ],
		 SAGL    => [ 0, "SAGL" ],
		 );

my %resource = ( PICTURE    => "PIC",
		 SOUND      => "SND",
                 CODE       => "STORY",
		 PALETTE    => "PALETTE",
                 RESOLUTION => "RESOL",
		 NOTE       => "ANNO",
		 AUTHOR     => "AUTH",
                 COPYRIGHT  => "COPY",
                 RELEASE    => "RELEASE",
		 );
sub PicType
{
    my $magic;
    seek CHUNK, 0, 0;
    read CHUNK, $magic, 10;
    if($magic =~ /^\xff\xd8....JFIF/) {
	return "JPEG";
    }
    if($magic =~ /^\x89PNG\x0d\x0a\x1a\x0a/) {
	return "PNG ";
    }
    die "Unknown picture type!\n";
}


sub SndType
{
    my $magic;
    seek CHUNK, 0, 0;
    read CHUNK, $magic, 12;
    if($magic =~ /^FORM....AIFF/) {
	return "AIFF";
    }
    seek CHUNK, 1080, 0;
    read CHUNK, $magic, 4;
    if($magic eq "M.K." || $magic eq "M!K!") {
	return "MOD ";
    }

    die "Unknown sound type!\n";
}


sub GamType
{
    my $magic;
    seek CHUNK, 0, 0;
    read CHUNK, $magic, 64;
    if($magic =~ /^Glul/) {
	return "GLUL";
    }
    if($magic =~ /^TADS2 bin\x0a\x0d\x1a\x00\x76/s) {
	return "TADG";
    }
    if($magic =~ /^MaSc/) {
	return "MSRL";
    }
    if($magic =~ /^(\x01|\x02|\x03|\x04|\x05|\x06|\x07|\x08).................[0-9][0-9][0-9][0-9][0-9][0-9]/s) {
        return "ZCOD";
    }
    if($magic =~ /^...[0-9][0-9]-[0-9][0-9]-[0-9][0-9].....................................\x00\x00\x00\x00\x00\x00\x00\x00/s) {
	return "HUGO";
    }
    if($magic =~ /^\x02[\x00-\x09][\x00-\x09][\x00-\x09]....\x00\x00\x00[\x00-\x01]........\x00\x00\x00[\x00-\x01]/s) {
	return "ALAN";
    }
    if($magic =~ /^\s*[0-9]+\s+[0-9]+\s+[0-9]+\s+[0-9]+\s+[0-9]+\s+/) {
	return "SAAI";
    }
    die "Unknown game type!\n";
}


sub bin32_num
{
    return vec($_[0], 0, 32);
}


sub num_bin32
{
    my $number = '';
    vec($number, 0, 32) = $_[0];
    return $number;
}

my $option_verbose = 0;
my $option_extension = 0;

sub list_file
{
    my ($usage, $number, $type, $length, $name) = @_;
    if($option_verbose) {
	if($option_verbose >= 2) {
	    if($usage) {
		printf "$usage %4d", $number;
	    } else {
		print "         ";
	    }
	    printf "  $type  %10d  ", $length;
	}
	print "$name\n";
    }

}

my $file = $_;
my @usagelist;
my @chunklist;

my $usagesize = 0;
my $chunksize = 0;
my $offset = 0;

my $name = "";
my $rest = "";
my $typedesc = "";
my $resid = "";
my $f = "/dev/null";
$| = 0;

open FILE, "<$ARGV[0]" or die "Could not open $ARGV[0]!\n";
my $blorb = "";
($blorb) = split /\./,$ARGV[0];
$blorb .= ".blb";
open BLORB, ">$blorb" or die "Could not open $blorb: $!\n";
my $picnum=0;
my $sndnum=0;
my $number=0;
while (<FILE>) {
    chomp;
    next if /^$/;
    next if /^!/;
    ($typedesc,$rest) = split;
    if (!(defined($resource{uc $typedesc}))) {
	print "Unknown resource record type $typedesc!\n";
	next;
    }
    my $name = $resource{uc $typedesc};
  SWITCH: {
      (/^PICTURE/ ||
       /^SOUND/) && do {($typedesc,$resid,$f) = split; 
			if (/^PICTURE/) {
			    $picnum++;
			    $number = $picnum;
			} else {
			    $sndnum++;
			    $number = $sndnum;
			}
			my $short=$namelist{$name}->[0];
			last SWITCH;
		    };
      
      (/^RESOLUTION/ ||
       /^PALETTE/    ||
       /^CODE/) && do { ($typedesc,$f) = split; 
			$number = 0;
			last SWITCH;
		    };
      $f = "/dev/null";
  }
    open CHUNK, "<$f" or die "Open of $f failed: $!\n";
    seek CHUNK, 0, 2;
    my $length = tell CHUNK;
    
    my $usage = $namelist{$name}->[0];
    my $type;
    my $is_IFF;
    if(ref $namelist{$name}->[1]) {
	$type = $namelist{$name}->[1]->();
    } else {
	$type = $namelist{$name}->[1];
    }
    if($usage) {
	push @usagelist, [ $usage, $number, $offset ];
	$usagesize += 12;
    }
    
    if($type eq "AIFF") { 
	$is_IFF = 1;
	$type = "FORM";
    }
    
    list_file($usage, $number, $type, $length, $f);
    
    if($is_IFF) {
	$length -= 8;
    }
    push @chunklist, [ $f, $type, $length, $is_IFF ];
    
    if($length % 2) {
	$length++;
    }
    
    $chunksize += 8 + $length;
    $offset += 8 + $length;
    close CHUNK;

}
close FILE;

print BLORB "FORM", num_bin32(4 + 12 + $usagesize + $chunksize), "IFRS";
print BLORB "RIdx", num_bin32(4 + $usagesize), num_bin32($#usagelist + 1);
foreach my $f (@usagelist) {
    print BLORB $f->[0], num_bin32($f->[1]),
    num_bin32(24 + $usagesize + $f->[2]);
}
foreach my $f (@chunklist) {
    my $buffer;
    # If it's not an IFF file, create a chunk header for it
    if(!($f->[3])) {
	print BLORB $f->[1], num_bin32($f->[2]);
    }
    open CHUNK, "<$f->[0]";
    seek CHUNK, 0, 0;
    while(read CHUNK, $buffer, 16384) {
	print BLORB $buffer;
    }
    if(($f->[2]) % 2) {
	print BLORB "\x0";
    }
}
exit 0;
