#!/usr/bin/perl -w


use strict;

use Win32API::File qw(
    createFile
    fileLastError
    fileConstant
    DeviceIoControl IOCTL_DISK_GET_MEDIA_TYPES IOCTL_DISK_FORMAT_TRACKS
    CloseHandle
);


exit main();


sub PickMedia
{
    my( $disk )= @_;
    my( @MediaType, %MediaType )= @{$Win32API::File::EXPORT_TAGS{MEDIA_TYPE}};
    for(  @MediaType  ) {
	$MediaType{fileConstant($_)}= $_;
    }
    $disk= "PhysicalDrive$disk"   if  $disk =~ /^\d+$/;
    my $h= createFile( "//./$disk", "q" )
      or  die "Can't read disk ($disk): ", fileLastError(), "\n";
    my $fmtGeom= "LL L L L L";
    my $lGeom= length pack $fmtGeom, (0)x6;
    my $aGeom;
    DeviceIoControl( $h, IOCTL_DISK_GET_MEDIA_TYPES,
      [], 0, $aGeom, 32*$lGeom, [], [] )
      or  die "Can't get media types for disk ($disk): ", fileLastError(), "\n";
    CloseHandle( $h )
      or  warn "Failed to close disk ($disk): ", fileLastError(), "\n";
    @MediaType= ();
    my $idx= 0;
    print "\nPlease select the desired density:\n\n";
    while(  $aGeom  ) {
	my( $cLoDiskCyls, $cHiDiskCyls, $uMediaType,
	    $cCylTracks, $cTrackSects, $cSectBytes )=
	  unpack $fmtGeom, substr( $aGeom, 0, $lGeom );
	substr( $aGeom, 0, $lGeom )= "";
	my $sMediaType= $MediaType{$uMediaType} || "Other($uMediaType)";
	my $cDiskCyls= $cHiDiskCyls*65356*65356 + $cLoDiskCyls;
	++$idx;
	my $meg= $cDiskCyls * $cCylTracks * $cTrackSects * $cSectBytes
	  / 1_024_000;	# Note the strange "floppy MB" of 1000*1024 bytes!
	print "  $idx) $sMediaType: $cDiskCyls cyl.s of $cCylTracks ",
	  "tracks of $cTrackSects sect.s of $cSectBytes bytes ($meg MB)\n";
	push @MediaType, [ $uMediaType, $cDiskCyls, $cCylTracks ];
	if(  0 != $cHiDiskCyls  ) {
	    warn "\t[The above media type cannot be formatted.]\n";
	}
    }
    print "\n";
    while( 1 ) {
	print "Enter the number of the density to use: ";
	my $resp= <STDIN>;
	die "Error reading response: $!\n"
	  unless  defined $resp;
	if(  $resp =~ /^[1-9]\d*$/  &&  $MediaType[$resp-1]  ) {
	    return @{$MediaType[$resp-1]};
	}
	warn "Invalid choice.\n";
    }
}


sub PickRange
{
    my( $what, $count )= @_;
    return( 0, 0 )   if  $count-- < 2;
    while( 1 ) {
	print
	  "\nEnter the range of ${what}s to format (or <CR> for 0..$count): ";
	my $resp= <STDIN>;
	die "Error reading response: $!\n"   unless  defined $resp;
	return( 0, $count )
	  if  $resp =~ /^\s*$/;
	if(  $resp !~ /^\s*(\d+)\D+(\d+)\s*$/  ) {
	    warn "Invalid response; does not contain two integers.\n";
	} elsif(  0 <= $1  &&  $1 <= $2  &&  $2 <= $count  ) {
	    return( $1, $2 );
	} else {
	    warn "Invalid range; not within 0..$count.\n";
	}
    }
}

sub main
{
    die "Usage:  $0 A:\n",
      "To format a floppy diskette in the A: drive.\n",
      "Note that a FAT file system is _not_ placed on the floppy.\n"
      unless  1 == @ARGV;
    my $disk= $ARGV[0];
    my( $media, $cyls, $hds )= PickMedia( $disk );
    my $h= createFile( "//./$disk", "rwke" )
      or  die "Can't access raw floppy (//./$disk): ",fileLastError(),"\n";
    # FORMAT_PARAMETERS:  MediaType, StartCyl, EndCyl, StartHead, EndHead
    my( $mincyl, $maxcyl )= PickRange( "cylinder", $cyls );
    my( $minhd, $maxhd )= PickRange( "head", $hds );
    warn "\nFormatting $disk cylinders $mincyl..$maxcyl, ",
      "heads $minhd..$maxhd ...\n";
    my $FmtParms= pack( "L*", $media, $mincyl, $maxcyl, $minhd, $maxhd );
    DeviceIoControl( $h, IOCTL_DISK_FORMAT_TRACKS,
      $FmtParms, 0, [], 0, [], [] )
      or  die "Can't format floppy (//./$disk): ",fileLastError(),"\n";
    return 0;
}