#! /usr/bin/perl
#---------------------------------------------------------------------
# $Id: pro_fmt 1305 2006-03-26 21:35:50Z cjm $
# Copyright 1996-2006 Christopher J. Madsen
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# 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 either the
# GNU General Public License or the Artistic License for more details.
#
# Create a blank ProDOS disk image
#---------------------------------------------------------------------

use AppleII::Disk 0.04;
use AppleII::ProDOS 0.04;
use Getopt::Long 2.10;
use strict;

our $VERSION = '0.04';

#---------------------------------------------------------------------
my $blocks = 280;
my $volume = 'NEWDISK';
my $order  = '';
my ($bootFrom, $extendToFullSize, $force);

Getopt::Long::config(qw(bundling no_getopt_compat));
GetOptions(
    'boot-from|b=s'   => \$bootFrom,
    'size|s=i'        => \$blocks,
    'dos-order|d'     => sub { $order = 'd' },
    'extend|e'        => \$extendToFullSize,
    'force|f'         => \$force,
    'prodos-order|p'  => sub { $order = 'p' },
    'volume|v=s'      => \$volume,
    'help'            => \&usage,
    'version'         => \&usage
) or usage();

my $filename = shift @ARGV;
defined($filename) or usage();

sub usage {
    print "pro_fmt $VERSION\n";
    exit if $_[0] and $_[0] eq 'version';
    print "\n" . <<'';
Usage:  pro_fmt [options] FILE
  -b, --boot-from=FILE  Copy boot blocks from disk image FILE
  -e, --extend          Extend FILE to its maximum size
  -f, --force           Overwrite an existing file
  -d, --dos-order       Make a DOS 3.3-order image file
  -p, --prodos-order    Make a ProDOS-order image file
  -s, --size=BLOCKS     Make the image BLOCKS blocks in size (default 280)
  -v, --volume=NAME     Use NAME for the ProDOS volume name (default NEWDISK)
      --help            Display this help message
      --version         Display version information

    exit;
} # end usage

#=====================================================================
if (not $force and -e $filename) {
  print STDERR "pro_fmt: $filename already exists (use --force to overwrite)\n";
  exit 1;
}

my $vol = AppleII::ProDOS->new($volume, $blocks, $filename, $order);

$vol->disk->fully_allocate if $extendToFullSize;

if ($bootFrom) {
  my $boot = eval { AppleII::Disk->new($bootFrom, 'r') };
  if ($@) {
    my $err = $@;
    $err =~ s! at \Q$0\E line \d+\n!!;
    die "$err\nDisk image $filename is not bootable, but is otherwise ok.\n";
  }

  $vol->disk->write_block(0, $boot->read_block(0));
  $vol->disk->write_block(1, $boot->read_block(1));
} # end if $bootFrom

__END__

=head1 NAME

pro_fmt - Create a blank Apple II ProDOS disk image file

=head1 SYNOPSIS

B<pro_fmt> [options] I<FILE>

=head1 DESCRIPTION

B<pro_fmt> creates blank ProDOS disk images.  The images are NOT
bootable, because they lack the necessary code in the boot blocks,
unless you use the "--boot-from" option to copy the boot blocks from a
bootable disk image.

Note that some emulators cannot deal with image files that are smaller
than their nominal size.  That is, they expect a 280 block disk image
file to be 143,360 bytes long.  Always use the "--extend" option when
creating image files for such emulators.

=head1 OPTIONS

 -b, --boot-from=FILE  Copy boot blocks from disk image FILE
 -e, --extend          Extend FILE to its maximum size
 -f, --force           Overwrite an existing file
 -d, --dos-order       Make a DOS 3.3-order image file
 -p, --prodos-order    Make a ProDOS-order image file
 -s, --size=BLOCKS     Make the image BLOCKS blocks in size
                         (default 280)
 -v, --volume=NAME     Use NAME for the ProDOS volume name
                         (default NEWDISK)
     --help            Display this help message
     --version         Display version information

=head1 REQUIREMENTS

B<pro_fmt> requires the modules AppleII::ProDOS and AppleII::Disk,
which are included with LibA2.

=head1 AUTHOR

Christopher J. Madsen E<lt>F<cjm@pobox.com>E<gt>

=cut

# Local Variables:
# tmtrack-file-task: "LibA2: pro_fmt.pl"
# End:
