{$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
{$M 16384,0,65535}

{
Written by Trixter / Hornet (Jim Leonard, trixter@hornet.org)
for the Flopper Project (Floppy disk boot emulator).  Dumps a
floppy diskette to an image file.

If you modify this program, please resubmit your changes to the Flopper
Project email/contact address, so that we may merge your changes to the
source distribution.

Program notes: This program assumes a color screen (i.e. a screen where
the video memory is located at b800.  If this is a problem, email me and
I'll fix it.  This program is not optimized very heavily--it simply gets
the job done.  Attempts to optimize it are welcome.  If you want to
squeeze that extra second of speed out for your 4.77MHz PC, be my guest,
but I've already tried it on my Tandy 4.77MHz machine and the floppy
drive was the slowest thing hindering dumping.  :-)

Design specifications required to be met for the emulator:

The logic of the program should be thus:
  read the command line to find the target filename for disk image.
  open said filename if valid enough.
  fill a 512 byte buffer with !!!!!!'s
  read 1 sector at a time, starting with head 0, track 0, sector 1
   into a 512 byte buffer.
  save 512 byte data into file
  advance to next sector until maximum sectors has been reached
  Once max sectors is reached, advance to next head, repeat above process
  once max sectors and max heads has been reached, then move onto next track
  once max head,sectors,tracks has been reached, close file and bail.

The reason for the buffer being filled with !!!'s before each read is
that if the disk has a bad sector, no data will be read (duh) and we can
mark those sectors as being bad with the !!!'s.  If there are games that
use a simple bad sector check for copy protection, the emulator can
handle that.  The emulator scans the read sector for !!!'s and will
return "sector not found" errors if found.  This is pretty lame, but may
save some cracking headaches.

Otherwise, games that use 1024 byte sectors, weird track #s, etc will
need to be cracked before the emulator (and this program) can handle it.
}

Program disk2img;

uses
  flprglob, {Flopper utils unit; global variables}
  flprdisk, {Flopper utils unit; low-level disk utilities}
  flprsprt, {Flopper utils unit; additional support routines}
  crt;

const {these are really variables, but I can initialize these here in one step}
  filename:string='output.img';
  displayhex:boolean=true;
  badsec9s:byte=0;  {quick'n'dirty format checking}
  badhead1s:word=0; {quick'n'dirty format checking}
  totalsectors:word=0;
  starttick:longint=0;
  screencolumns=80;
  Recover:boolean=false;
  Query:boolean=false;

var
  ticker:longint absolute $0:$46c;

{------Main program functions------------------------------------------------}

Function DriveStatusString(status:byte):string;
begin
  case status of
    $00:DriveStatusString:='status OK.';
    $01:DriveStatusString:='invalid function in AH or invalid parameter?';
    $02:DriveStatusString:='address mark not found...';
    $03:DriveStatusString:='disk write-protected!';
    $04:DriveStatusString:='sector not found (read error?)';
    $06:DriveStatusString:='floppy disk removed?';
    $08:DriveStatusString:='DMA overrun!';
    $09:DriveStatusString:='attempted DMA across 64K boundary or >80h sectors!';
    $0C:DriveStatusString:='bad media type or invalid media...';
    $10:DriveStatusString:='uncorrectable CRC error!';
    $20:DriveStatusString:='controller failed!';
    $40:DriveStatusString:='seek failed!';
    $80:DriveStatusString:='timeout... (disk not ready)';
    { hard-drive and special codes, for anyone interested }
    { $05:writeln('reset failed (hard disk)');}
    { $07:writeln('drive parameter activity failed (hard disk)');}
    { $0A:writeln('bad sector detected (hard disk)');}
    { $0B:writeln('bad track detected (hard disk)');}
    { $0D:writeln('invalid number of sectors on format (PS/2 hard disk)');}
    { $0E:writeln('control data address mark detected (hard disk)');}
    { $0F:writeln('DMA arbitration level out of range (hard disk)');}
    { $10:writeln('uncorrectable CRC or ECC data error!');}
    { $11:writeln('data ECC corrected (hard disk)');}
    { $31:writeln('no media in drive (IBM/MS INT 13 extensions)');}
    { $32:writeln('incorrect drive type stored in CMOS (Compaq)');}
    { $AA:writeln('drive not ready (hard disk)');}
    { $B0:writeln('volume not locked in drive (INT 13 extensions)');}
    { $B1:writeln('volume locked in drive (INT 13 extensions)');}
    { $B2:writeln('volume not removable (INT 13 extensions)');}
    { $B3:writeln('volume in use (INT 13 extensions)');}
    { $B4:writeln('lock count exceeded (INT 13 extensions)');}
    { $B5:writeln('valid eject request failed (INT 13 extensions)');}
    { $BB:writeln('undefined error (hard disk)');}
    { $CC:writeln('write fault (hard disk)');}
    { $E0:writeln('status register error (hard disk)');}
    { $FF:writeln('sense operation failed (hard disk)');}
  else
    DriveStatusString:='unknown error code (ACK!)';
  end;
end;



Procedure DumpInit;

  Procedure printhelp;
  begin
    writeln('Usage is:  "DISK2IMG filename.ext [options]", where:');
    writeln;
    writeln('Option  Description                              Default');
    writeln('~~~~~~  ~~~~~~~~~~~                              ~~~~~~~');
    writeln('  /Dx   selects what Drive to work on            /d',upcase(chr(65+CurDrive)));
    writeln('  /N    do Not build the sector display          ',not displayhex);
    writeln('  /Txx  number of Tracks                         /t',numtracks);
    writeln('  /Sxx  number of Sectors per track              /s',numsectors);
    writeln('  /Hx   number of Heads                          /h',numheads);
    writeln('  /Zx   sector siZe                              /z',sectorsize);
    writeln('  /R    Recover mode (ignore errors and retry)   ',Recover);
    writeln('  /Q    Query boot sector to get disk parameters ',Query);
    writeln;
    writeln('Built-in settings reflect a ',numtracks*numsectors,'K diskette in drive ',upcase(chr(65+CurDrive)),':');
    writeln('If no filename is specified, the name "',filename,'" will be used.');
    writeln;
    writeln('Examples:');
    writeln('DISK2IMG mygame.img /da                    dumps the disk in A: to "mygame.img"');
    writeln('DISK2IMG bootdisk.img /db /q        query tracks, etc. from disk before dumping');
    halt(1);
  end;

  Procedure GetOptions;
  var
    foos:string;
    fooc:char;

  begin
    {help}
    if getopt('?')<>#0
      then printhelp;

    {new filename?}
    if paramstr(1)<>'' then begin
      foos:=paramstr(1);
      if (foos[1]<>'/')
      and (foos[1]<>'-')
        then filename:=paramstr(1);
    end;

    {drive to work on}
    if getopt('d')<>#0
      then begin
        foos:=getopt('d');
        fooc:=upcase(foos[1]);
        CurDrive:=ord(fooc)-65;
      end;

    {hex display}
    if getopt('n')<>#0
      then displayhex:=false;

    {number of tracks}
    if getopt('t')<>#0
      then numtracks:=strtoint(getopt('t'));

    {number of sectors per track}
    if getopt('s')<>#0
      then numsectors:=strtoint(getopt('s'));

    {number of heads}
    if getopt('h')<>#0
      then numheads:=strtoint(getopt('h'));

    {sector size}
    if getopt('z')<>#0
      then sectorsize:=strtoint(getopt('z'));

    {enable blatant disregard for errors}
    if getopt('r')<>#0
      then Recover:=true;

    {query drive for params.}
    if getopt('q')<>#0
      then Query:=true;
  end;

  Procedure SetupVars;
  var
    status:byte;
    dsp:^boot_structure;
  begin
    ResetDrive(CurDrive);

    if Query then begin
      getmem(sectorbuffer,8192);
      status:=ReadSector(CurDrive, 0, 0, 1, sectorbuffer);
      if status<>0
        then fatalerror('Got '+DriveStatusString(status)+' when trying to query boot sector!');
      dsp:=sectorbuffer;
      sectorsize:=dsp^.bytes_per_sector;
      numsectors:=dsp^.sectors_per_track;
      numheads:=dsp^.number_of_heads;
      numtracks:=dsp^.total_sectors div numsectors div numheads;
      freemem(sectorbuffer,8192);
    end;

    getmem(sectorbuffer,sectorsize);
    tracksize:=sectorsize*numsectors*numheads;
    getmem(trackbuffer,tracksize);
    totalsectors:=numtracks*numsectors*numheads;
  end;

  Procedure PrintWelcome;
  var
    foo:byte;
  begin
    directvideo:=true;
    checksnow:=false;
    textbackground(black);
    textcolor(lightgray);
    asm
      mov  ax,0003h
      int  10h
    end;
    gotoxy(1,20);
    for foo:=0 to 79 do write('Ä');

    PrintHeader('DISK2IMG','Dumps a diskette to an image file','0.73',980515);
  end;

begin
  PrintWelcome;
  GetOptions;
  SetupVars;
end;

Procedure DumpDo;
const
  curstatus:byte=0;

var
  sectors,heads,tracks:byte;
  foop:^byte;
  f:file;

  Procedure DisplaySector;assembler;

  asm
    push ds {save this, because we need it}

    mov  ax,$b800
    mov  es,ax
    mov  di,(ScreenColumns * 2)-(secdisplaylinelength*2){location on screen to start}

    mov  ax,sectorsize
    mov  dl,secdisplaylinelength
    div  dl
    mov  dx,ax

    lds  si,sectorbuffer
    cld

    @displayloop:

      mov  cx,secdisplaylinelength
      @lineloop:
        lodsb
        mov  ah,07 {0 background, 7 foreground}
        stosw
      loop @lineloop

      add  di,(ScreenColumns * 2)-(secdisplaylinelength*2)
      dec  dx

    jnz  @displayloop

    pop  ds {go back to old ds or we start going wonky ;) }
  end;

  Procedure DisplayHeader(s:string);
  const
    statusline=18;
  begin
    {clear line}
    fillchar(ptr(segb800,(statusline-1) * ScreenColumns * 2)^,ScreenColumns *2,0);
    gotoxy(1,statusline);
    write(s);
  end;

  Procedure DisplayDriveStatus;

    function secstomins(secs:real):string;
    var
      min,sec:string;
    begin
      min:=inttostr(round(secs) div 60);
      sec:=inttostr(round(secs) mod 60);
      if sec[0]=#1
        then secstomins:=min+':0'+sec
        else secstomins:=min+':'+sec;
    end;

  var
    percent:real;
    totalsecs:real;
    secselapsed:real;
    secsremaining:real;

  begin
    gotoxy(1,1);
    writeln('     Drive ',chr(65+CurDrive),':');
    writeln('    Track: ',tracks,' ');
    writeln('     Head: ',heads,' ');
    writeln('   Sector: ',sectors,' ');
    writeln('Sect.size: ',sectorsize);

    secselapsed:=(ticker-starttick)/18.2;
    percent:=(cursector/totalsectors) * 100;
    if (percent<>0)
      then totalsecs:=((ticker-starttick)/18.2) / percent * 100
      else totalsecs:=1;
    secsremaining:=totalsecs-secselapsed;

    {writeln('Sec.elap.: ',secselapsed:2:0);}
    writeln(' Complete: ',percent:2:0,'%');
    {writeln(totalsecs:3:0,' total time');}

    gotoxy(1,(sectorsize div secdisplaylinelength)+1);

    writeln('Time remaining: ',secstomins(secsremaining),'  ');

    displayheader(#13);

    write('Drive status code #',curstatus,': ',DriveStatusString(curstatus));
    {writeln(#32:79);}
  end;

  Procedure CheckForUserExit;
  begin
    if keypressed then fatalerror('Exited by user.');
  end;

  Procedure WaitRetrace;
  begin
    while port[$3da] and 8=0 do;
    while port[$3da] and 8=8 do;
    while port[$3da] and 1=1 do;
    while port[$3da] and 1=0 do;
  end;

  Procedure PrepareBuffer;
  begin
    {fill sector buffer with !'s}
    fillchar(sectorbuffer^,sectorsize,'!');
  end;

begin
  {get the output file ready}
  assign(f,filename);
  rewrite(f,1);
  {initialize the floppy controller subsystem}
  if (ResetDrive(CurDrive) <> 0)
    then fatalerror('Could not reset disk drive '
                    +chr(65+CurDrive)+':; error status: '
                    +inttostr(ResetDrive(CurDrive)));
  displayheader('Drive status: Resetting disk controller...');
  resetdrive(CurDrive);
  {read dummy sector three times in a row to force drive to spin up}
  displayheader('Drive status: Forcing motor to spin...');
  for sectors:=0 to 2 do begin
    displayheader('Reading dummy sector #'+inttostr(sectors)+'...');
    curstatus:=ReadSector(CurDrive,0,0,0,sectorbuffer);
    if curstatus<>0 then begin
      displayheader('Resetting drive...');
      resetdrive(CurDrive);
    end;
  end;
  displayheader('Drive status: Checking drive motor...');
  if (DriveMotorStatus and $F = 0) then fatalerror('Disk drive did not spin up!');
  starttick:=ticker;
  for tracks:=0 to numtracks-1 do begin
    {reset offset}
    foop:=trackbuffer;
    {read the sectors a track at a time for maximum speed}
    for heads:=0 to numheads-1 do
      for sectors:=1 to numsectors do begin
        {fill sector buffer with !'s}
        PrepareBuffer;
        {read a sector into the sector buffer}
        curstatus:=ReadSector(CurDrive,heads,tracks,sectors,sectorbuffer);
        if (Recover) and (curstatus<>0)
          then
            while curstatus<>0 do begin
              WaitRetrace; DisplayHeader('(Recover) Drive status: '+DriveStatusString(curstatus));
              resetdrive(CurDrive);
              WaitRetrace; write('  Re-Reading Sector...');
              PrepareBuffer;
              curstatus:=ReadSector(CurDrive,heads,tracks,sectors,sectorbuffer);
              {if user says screw this, then move on}
              if keypressed then begin
                while keypressed do readkey;
                WaitRetrace; DisplayHeader('(Recover) Aborting this sector...');
                break;
              end;
            end;
        {if curstatus <> 0, then we have an error and we should handle it}
        if curstatus<>0 then begin
          {record some stuff for quick'n'dirty error checking}
          resetdrive(CurDrive);
          if (sectors=9) then inc(badsec9s);
          if (heads=(numheads-1)) then inc(badhead1s);
        end;
        {display the sector on the screen for eyecandy purposes}
        if displayhex then DisplaySector;
        {display drive status}
        DisplayDriveStatus;
        {move the sector data into the track buffer...}
        move(sectorbuffer^,foop^,sectorsize);
        {...and increment the track buffer offset for next time}
        inc(foop,sectorsize);
        inc(cursector);
        {check for keypress and exit this procedure if a key is hit}
        CheckForUserExit;
      end;
    {dump 'em}
    blockwrite(f,trackbuffer^,TrackSize);
  end;
  close(f);
end;

Procedure DumpDone;

  Procedure FreeVars;
  begin
    freemem(trackbuffer,TrackSize);
    freemem(sectorbuffer,sectorsize);
  end;

  Procedure CleanUp;

    procedure ReportError(actualtype,newswitch:string);
    begin
      textcolor(yellow);
      writeln('The disk you just dumped appears to ',actualtype,'.');
      writeln('You should re-dump it with the "-',newswitch,'" command-line switch.');
      textcolor(lightgray);
      writeln;
    end;

  begin
    fillchar(ptr(segb800,0)^,8*(ScreenColumns * 2),0);
    gotoxy(78,25);
    writeln;
    writeln('Done.');
    {any "AI" to report?}
    {if number of bad sector 9's == the number of tracks*heads, then
     every single sector 9 didn't read--which means it's probably an 8-sector
     disk.  Warn user appropriately.}
    if badsec9s=(numtracks*numheads)
      then reporterror('have 8 sectors per track','s8');
    {if number of bad sectors on the second side == everything then
     every single sector on the second side didn't read--which means it's probably a
     single-sided disk.  Warn user appropriately.}
    if badhead1s=(numtracks*numsectors)
      then reporterror('be a single-sided disk','h1');
  end;

begin
  FreeVars;
  CleanUp;
end;

{------Main program------}

begin
  DumpInit;
  DumpDo;
  DumpDone;
end.