#!/usr/bin/perl -w
#
#	oricdadu - dump data contained in Oric BASIC DATA statements
#	AYM 2002-08-10
#

# This file is copyright André Majorel 2002.
# 
# This program is free software; you can redistribute it and/or modify it under
# the terms of version 2 of the GNU General Public License as published by the
# Free Software Foundation.
# 
# 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.
# 
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA 02111-1307, USA.


use strict;
use Getopt::Long;


my $version = '0.1.1';


sub err (@);


my $action     = 'dump';
my $output     = undef;
my $skiptoline = undef;
my $skipitems  = 0;


Getopt::Long::Configure 'bundling', 'no_ignore_case';
if (! GetOptions
  'help'    => sub { $action = 'help' },
  'l'       => sub { $action = 'list' },
  'n=i'     => \$skiptoline,
  'o=s'     => \$output,
  's=i'     => \$skipitems,
  'version' => sub { $action = 'version' })
{
  err "syntax error, try oricdadu --help";
  exit 1;
}
if (@ARGV > 1)
{
  err "too many arguments, try oricdadu --help";
  exit 1;
}

# Honour --help
if ($action eq 'help')
{
  print "Usage:\n",
  "  oricdadu --help\n",
  "  oricdadu --version\n",
  "  oricdadu [-l] [file]\n",
  "  oricdadu [-n num] [-o file] [-s num] [file]\n",
  "Options:\n",
  "  --help    Print usage to standard output and exit successfully\n",
  "  --version Print version number to standard output and exit successfully\n",
  "  -l        Print human readable list of DATA items to standard output\n",
  "  -n num    Skip to BASIC line number num\n",
  "  -o file   Write dump to file (default is standard output)\n",
  "  -s num    Skip the first num DATA items\n";
  exit 0;
}

# Honour --version
if ($action eq 'version')
{
  print "$version\n";
  exit 0;
}

# Honour -o
if (defined $output)
{
  if (! open OUTPUT, ">$output")
  {
    err "$output: $!\n";
    exit 1;
  }
  binmode OUTPUT;
  select OUTPUT;
}
else
{
  if (-t STDOUT)
  {
    err "won't dump binary data to a terminal";
    exit 1;
  }
}

my $data;
for (my $pln = 1; defined (my $line = <>); $pln++)
{
  chomp $line;
  if ($line !~ /^\s*(\d+)\s+/)
  {
    err "$ARGV($pln): no line number";
    exit 1;
  }
  my $lln = $1;
  next if defined $skiptoline && $lln < $skiptoline;
  $line =~ s/^\s*\d+\s+//;
  if ($line =~ /^DATA/)
  {
    $line =~ s/^DATA\s*//;
    my @items = map ($_ eq '' ? 0 : $_, split (/\s*,\s*/, $line, 9999));
    if ($action eq 'list')
    {
      print "$lln: @items\n";
    }
    else
    {
      # Honour -s
      for (; @items > 0 && $skipitems > 0; $skipitems--)
      {
	shift @items;
      }
      foreach my $item (@items)
      {
	if ($item =~ /^#([0-9a-fA-F]{1,2})$/)  # A byte in hex (#00..#FF)
	{
	  $data .= chr hex $1;
	}
	elsif ($item =~ /^#([0-9a-fA-F]{3,4})$/)  # A word in hex (#0000..#FFFF)
	{
	  my $val = hex $1;
	  $data .= chr ($val & 0xff);
	  $data .= chr ($val >> 8);
	}
	elsif ($item =~ /^(\d+)$/ && $1 <= 255)  # A byte in decimal (0..255)
	{
	  $data .= chr $1;
	}
	else
	{
	  err "$ARGV($pln): bad DATA item \"$item\"";
	}
      }
    }
  }
}
print $data if $action eq 'dump' && defined $data;
exit 0;


sub err (@)
{
  print STDERR "oricdadu: ", @_, "\n";
  return 1;
}