#
#   iPR Resource Compiler - compiles external resources into classes
#   for inclusion into application binary. Refactored from the Xitami
#   Resource Compiler
#
#   Copyright (c) 1996-2009 iMatix Corporation
#
#   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.
#
#   For information on alternative licensing for OEMs, please contact
#   iMatix Corporation.
#

initialise_program_data ();
parse_argument_values ();
open_output_file ();
generate_output_header ();

while (get_next_input_file ()) {
    load_input_file_data ();
    generate_resource_item ();
}
generate_output_footer ();
close_output_file ();


#########################   INITIALISE PROGRAM DATA   #########################

sub initialise_program_data
{
    $version    = "1.3";
    $me         = "ipr_resource";
    $copyright  = "Copyright (c) 1998-2009 iMatix Corporation";
    $bucket_max = 2097152;              #  IPR_BUCKET_MAX_SIZE

    if (@ARGV == 0) {
        print <<".";
$me - iPR Resource Compiler V$version
$copyright

Syntax: ipr_resource.pl [-c] infile [classfile]
    Converts the binary resource(s) in infile into an iCL class as
    specified by classfile. If classfile is omitted, creates a file with
    the same name as infile, and the extension '.icl'.  If the infile name
    starts with '\@' it processed as a list of files to process, one per
    line.  If -@ is specified, has the same effect as prefixing '@' to tje
    infile.
.
    exit (0);
    }

    #   Prepare date and time variables
    ($sec, $min, $hour, $day, $month, $year) = localtime;
    $date = sprintf ("%4d/%02d/%02d", $year + 1900, $month + 1, $day);
    $time = sprintf ("%2d:%02d:%02d", $hour, $min, $sec);

    ($sec, $min, $hour, $day, $month, $year, $wday) = gmtime;
    @day_name = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
    @mon_name = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
                 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");

    $gmtime = sprintf ("%s, %02d %s %d %02d:%02d:%02d GMT",
        $day_name [$wday], $day, $mon_name [$month], $year + 1900,
        $hour, $min, $sec);
}


##########################   PARSE ARGUMENT VALUES   ##########################

sub parse_argument_values
{
    #   Process arguments
    if ($ARGV [0] eq "-\@") {
        $infile = "\@".$ARGV [1];
        $outfile = $ARGV [2];
    }
    else {
        $infile = $ARGV [0];
        $outfile = $ARGV [1];
    }
    #   If @infile, load list of files to process from that file
    #   Ignore blank lines and comments starting with #
    if ($infile =~ /^@([^@]+)/) {
        $infile = $1;
        open (INFILE, "$infile") || die "Could not open '$infile': $!";
        while (<INFILE>) {
            chop;
            push (@infiles, $_) unless /^#/ || /^$/;
        }
        close (INFILE);
    }
    else {
        push (@infiles, $infile);
    }
    $basename = $infile;
    $basename =~ tr/A-Z/a-z/;               #   Get basename in lowercase
    $basename = $` if $basename =~ /\./;    #   Drop extension if any
    $outfile  = $basename.".icl" unless defined ($outfile);
    @sorted = sort (@infiles);
    $sorted_size = int (@sorted);
}


#############################   OPEN OUTPUT FILE   ############################

sub open_output_file
{
    open (OUTFILE, ">$outfile") || die "Could not create '$outfile': $!";
}


##########################   GENERATE OUTPUT HEADER   #########################

sub generate_output_header
{
    print OUTFILE <<".";
<?xml?>
<!--
    Generated by the iPR Resource Compiler $version on $date.
    $copyright
 -->
<class
    name      = "$basename"
    comment   = "Resource class for $basename"
    version   = "1.0"
    script    = "icl_gen"
    >
<doc>
    Provides compiled resources, i.e. external files that are shipped with
    the application.
</doc>

<inherit class = "icl_base" />
<import class = "ipr_bucket" />

<private name = "header">
typedef struct {
    qbyte size;
    byte  data [1];
} $basename\_resource_t;
</private>
.
}


###########################   GET NEXT INPUT FILE   ###########################

sub get_next_input_file
{
    $infile = shift (@infiles);
    if ($infile) {
        return (1);
    }
    else {
        return (0);
    }
}


###########################   LOAD INPUT FILE DATA   ##########################

sub load_input_file_data
{
    #   Read binary contents of file, up to IPR_BUCKET_MAX size
    open (INFILE, "$infile") || die "Could not open '$infile': $!";
    binmode (INFILE);
    $file_size = read (INFILE, $buffer, $bucket_max);
    close (INFILE);
}


##########################   GENERATE RESOURCE ITEM   #########################

sub generate_resource_item
{
    local ($basename);

    $file_ext = $infile =~ /\./? $': ".";
    $basename = $infile;
    $basename =~ tr/A-Z./a-z_/;             #   Get basename in lowercase
    $basename = $' if $basename =~ /\\|\//; #   Drop path if any
    print OUTFILE <<".";

<private name = "header">
static struct {
    qbyte size;
    byte  data [$file_size];
} res_$basename = {
    $file_size,
    {
.
    $on_line = 0;
    for ($counter = 0; $counter < $file_size; $counter++) {
        $byte = ord (substr ($buffer, $counter, 1));
        print  OUTFILE " " x 6 if $on_line == 0;
        printf OUTFILE "0x%02x", $byte;
        print  OUTFILE ", " unless $counter == $file_size - 1;
        if (++$on_line == 12) {
            $on_line = 0;
            print OUTFILE "\n";
        }
    }
    print OUTFILE "\n" unless $on_line == 0;
    print OUTFILE <<".";
    }
};
</private>
.
}


##########################   GENERATE OUTPUT FOOTER   #########################

sub generate_output_footer
{
    print OUTFILE <<".";

<private name = "header">
static struct {
    char *filename;
    void *resource;
} $basename\_table [$sorted_size] = {
.
    for ($count = 0; $count < $sorted_size; $count++) {
        $_ = $sorted [$count];
        $_ = $' if /\\|\//;             # Strip off path, if any
        print OUTFILE "    { \"$_\", ";
        $_ =~ tr/A-Z./a-z_/;            #   Get basename in lowercase
        print OUTFILE "&res_$_ }";
        print OUTFILE "," unless $count == $sorted_size - 1;
        print OUTFILE "\n";
    }
    print OUTFILE <<".";
};
</private>

<method name = "get" return = "bucket">
    <doc>
    Returns specified resource file as a bucket of data or NULL if the
    resource file is not known.  Note that resources are limited in size
    to the maximum size of a bucket (IPR_BUCKET_MAX).
    </doc>
    <argument name = "filename" type = "char *">Name of resource to find</argument>
    <declare name = "bucket" type = "ipr_bucket_t *">Returned bucket</declare>
    <local>
    $basename\_resource_t
        *resource;                      //  Found resource
    uint
        index;                          //  Index into resource table
    </local>
    //
    resource = NULL;
    for (index = 0; index < tblsize ($basename\_table); index++) {
        if (streq ($basename\_table [index].filename, filename)) {
            resource = $basename\_table [index].resource;
            break;
        }
    }
    if (resource) {
        bucket = ipr_bucket_new (0);
        bucket->data = resource->data;
        bucket->cur_size = resource->size;
    }
    else
        bucket = NULL;
</method>

<method name = "selftest">
    <local>
    ipr_bucket_t
        *bucket;
    </local>
.
    for ($count = 0; $count < $sorted_size; $count++) {
        $resource = $sorted [$count];
    print OUTFILE <<".";
    //  Check we can find $resource
    bucket = $basename\_get ("$resource");
    assert (bucket);
    ipr_bucket_destroy (&bucket);
.
    }
    print OUTFILE <<".";
</method>

</class>
.
}


############################   CLOSE OUTPUT FILE   ############################

sub close_output_file
{
    close (OUTFILE);
}
