Program ATARIO(Input,Output);

{
Feel free to copy, distribute and modify this program to your hearts
content.  I retain no rights to it, nor do I care to hear complaints
about it.  Send any praises that you desire.

Dave Brandman
805 Rotherham Drive
Manchester, MO  63011
}

{
I took heed of the previos statement and modified the program.  It will
now work on an XF551 disk, formatted DS/DD under MyDOS 4.5.  There is an
option in the configure menu to use "other drives".  This sets the program
back the way it was (which may have been correct for older drives, like the
Percom).  There should be no need to use this option with a SS/DD disk.  There
is also an option to use another physical drive on the PC which uses absolute
drive numbers.  After changing drives, get a directory to see if it is the
right one.  Lastly, I added the option to change the colors.  This program
works with Turbo Pascal 3.0 and with Turbo Pascal 5.5.

Kevin White
235 Race St.
Berea, OH 44017
September 6, 1991
}

Uses Turbo3, Crt, Dos;      {Comment this line out if you use Turbo 3.0
                             If you use Turbo 3.0, a change needs to be
                             made in the Getsec function.  Look there before
                             compiling!}

Type
   Str          = Array [1..256] of Byte;
   Bstring      = Array [1..1000] of Char;
   Lstring      = String[128];

Var
   File_Map,
   Buffer             : Str;
   Disk_Side,
   File_Sector_Index,
   Next_File_Sector,
   File_Sector_Size,
   Choice,
   Directory_Index,
   Directory_Sector,
   Orig_Sector_Value,
   Disk_Base_Ofs,
   Disk_Base_Seg,
   Sector_Size,
   Sector_Per_Track,
   Sector_Per_Cyl,
   Sides_Per_Disk,
   Dos_Sector,
   Bios_Sector_Size,
   Bios_Sector,
   Bios_Track,
   Bios_Side,
   Drive,
   File_Map_Index,
   Start_Directory,
   Last_LJK_Sector_Size,
   Cmd,
   XF551,
   ColorText, ColorBack,
   Diskio_Status      : Integer;
   Diskio_Error,
   Pending_Eof,
   Eof                : Boolean;
   Max_Entries,
   Dos_Mode,
   File_Entry_Status  : Byte;

Procedure Init;

Begin   { Init }
   Sector_Size := 256;     { ATARI Format }
   Bios_Sector_Size := 1;  { 256 Byte Sectors }
   Sector_Per_Track := 18; { ATARI Format }
   Sides_Per_Disk := 1;    { ATARI Format }
   Drive := 0;             { Drive A      }
   Sector_Per_Cyl := Sector_Per_Track * Sides_Per_Disk;
   Disk_Base_Ofs := Memw[0:120];
   Disk_Base_Seg := Memw[0:122];
   Orig_Sector_Value := Mem[Disk_Base_Seg:Disk_Base_Ofs+3];
   Disk_Side := 1;
   Dos_Mode := 0;
   Max_Entries := 8;
   Start_Directory := 361;
   XF551 := 1;
   Cmd := 2;               { Read }
   HighVideo;
   ColorText := 10;
   ColorBack := 4;
   TextColor (ColorText);
   TextBackground (ColorBack);
End;

Function Compare(str1,str2 : Lstring) : Boolean;

Var
   len1,
   len2,
   i     : Integer;

Begin
   Compare := False;
   len1 := length(str1);
   len2 := length(str2);
   If (len1 = len2) Then Begin
      I := 1;
      While (upcase(str1[i]) = upcase(str2[i])) and (i <= len1) do
         i := succ(i);
      If i > len1 Then
         Compare := True;
   End;
End;

Function Hex1(num : integer) : lstring;

Var
   hib, lob : Integer;

Begin    { Hex1 }
   hib := lo(num shr 4 or $30);
   If hib > 57 Then
      hib := hib + 7;
   lob := lo(num and $0F or $30);
   If lob > 57 Then
      lob := lob + 7;
   hex1 := char(hib) + char(lob);
End;

Procedure Pause;

Var
   Ch : Char;

Begin  { Pause }
   Gotoxy(1,25);
   Write('Hit Any Key to Continue');
   Repeat
   Until
      Keypressed;
   Read(Kbd,Ch)
End;

Function Get_Choice(Low, High : Integer) : Integer;

Var
   Ch     : Char;
   Choice : Integer;

Begin
   Repeat
      Gotoxy(1,24); Write('===> ___    ');
      Gotoxy(6,24);
      Repeat
      Until
         Keypressed;
      Read(Kbd,Ch);
      If (Ch = #27) and (Keypressed) Then Begin
         Read(Kbd,Ch);
         Choice := Ord(Ch) - 58;
         If Choice = 10 Then
            Choice := 0;
         End
      Else
         Choice := Ord(Ch) - 48;
   Until
      (Choice >= Low) and (Choice <= High);
   Get_Choice := Choice;
   Clrscr;
End;

Function Getyn : Char;

Var
   Ch     : Char;

Begin
   Repeat
      Repeat
      Until
         Keypressed;
      Read(Kbd,Ch);
      Ch := Upcase (Ch)
   Until
      (Ch = 'Y') or (Ch = 'N');
   Getyn := Ch;
End;

Function Getsec : Integer;

var
   i,
   Attempts,
   Diskio_Status : Integer;
   Regs : Registers;  {Comment out this line and un-comment the next group
                       if you have Turbo Pascal 3.0}
{  Regs : Record
             Ax    : Integer;
             Bx    : Integer;
             Cx    : Integer;
             Dx    : Integer;
             Bp,Si,Di,Ds : Integer;
             Es    : Integer;
             Flags : Integer;
          End;      }


Begin   { Getsec }
   Attempts := 0;
   Diskio_Status := -1;
   While (Diskio_Status <> 0) and (Attempts < 3) Do Begin
      Mem[Disk_Base_Seg:Disk_Base_Ofs+3] := Bios_Sector_Size;
      Regs.Es := Seg(Buffer);
      Regs.Bx := Ofs(Buffer);
      Regs.Dx := Drive + Swap(Bios_Side);
      Regs.Cx := Bios_Sector + Swap(Bios_Track);
      Regs.Ax := Swap(Cmd) + 1;
      Intr($13,regs);
      Diskio_Status := Hi(Regs.Ax);
      Mem[Disk_Base_Seg:Disk_Base_Ofs+3] := Orig_Sector_Value;
      Attempts := Succ(Attempts);
      If Diskio_Status <> 0 Then Begin
         Regs.Ax := $0000;
         Intr($13,regs); End
      Else
         For I := 1 to Sector_Size Do
            Buffer[I] := Not Buffer[I];
   End;
   Getsec := Diskio_Status;
End;

Procedure Display_Status(secnum : integer);

Begin      { Display_Status }
   Writeln;
   Writeln('Dos_Sector  Bios_Side   Bios_Track   Bios_Sector   Return_Code');
   Gotoxy(3,9); Write(secnum:3);
   Gotoxy(16,9); Write(Bios_Side:1);
   Gotoxy(28,9); Write(Bios_Track:2);
   Gotoxy(42,9); Write(Bios_Sector:2);
   Gotoxy(56,9); Writeln(Diskio_Status:2);
   Writeln; Writeln;
End;

Procedure Get_Sector(Secnum : Integer);

Begin   { Get_Sector }
   If Disk_Side = 2 Then
      Secnum := 1440 - Secnum;
   If Secnum <= 720 Then
      Bios_Side := 0
   Else Begin
      Bios_Side := 1;
      Secnum := (1440 + XF551) - Secnum;
   End;
   Diskio_Error := False;
   Bios_Sector := Secnum mod Sector_Per_Track;
   If Bios_Sector = 0 Then
      Bios_Sector := Sector_Per_Track;
   Bios_Track := Secnum div Sector_Per_Track;
   If Bios_Sector = Sector_Per_Track Then
      Bios_Track := Bios_Track - 1;
   If (Bios_Track >= 0) and (Bios_Track < 41) Then
      Diskio_Status := Getsec
   Else
      Diskio_Status := 64;
   If Diskio_Status <> 0 Then
      Diskio_Error := True;
End;


Procedure Display_Sector;

Var
   Byt   : Byte;
   I,
   J,
   Index : Integer;
   Chr1  : Char;
   Hexstring,
   Asciistring : lstring;

Begin   { Display_Sector }
   Write('      00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F');
   Writeln('      ----+----+----+-');
   Index := 1;
   For I := 1 to Sector_Size div 16 Do Begin
      Hexstring := '';
      Asciistring := '';
      For J := 1 to 16 Do Begin
         Byt := Buffer[Index];
         Index := succ(Index);
         hexstring := hexstring + hex1(Ord(Byt)) + ' ';
         Case Byt Of
            $00..$19 : chr1 := '.';
            $20..$7E : chr1 := Char(Byt);
            $7F..$9F : chr1 := '.';
            $A0..$FE : chr1 := Char(Byt-128);
            $FF      : chr1 := '.';
         End;
         asciistring := asciistring + chr1;
      End;
      Writeln('  ',hex1((i-1)*16),': ',hexstring,'     ',asciistring);
   End;
   Writeln;
End;

Procedure Get_Next_File_Sector;

Begin   { Get_Next_File_Sector }
   If Next_File_Sector > 0 Then Begin
      Get_Sector(Next_File_Sector);
      If Dos_Mode = 0 Then Begin
         File_Sector_Size := Buffer[Sector_Size];
         Next_File_Sector := Buffer[Sector_Size-1] +
            swap(Buffer[Sector_Size-2]);
         If File_Entry_Status = 0 Then
            Next_File_Sector := Next_File_Sector and $03FF;
         End
      Else Begin
         File_Sector_Size := Sector_Size;
         Next_File_Sector := File_Map[File_Map_Index] +
            Swap(File_Map[File_Map_Index + 1]);
         If Next_File_Sector = 0 Then
            File_Sector_Size := Last_LJK_Sector_Size;
         File_Map_Index := File_Map_Index + 2;
      End;
      File_Sector_Index := 1;
      End
   Else
      Pending_Eof := True;
End;

Function Get_Next(var entry : lstring) : Boolean;

Var
   i      : integer;

Begin      { Get_Next }
   Repeat
      If directory_index = Max_Entries Then Begin
         directory_sector := succ(directory_sector);
         directory_index := 0;
         Get_Sector(directory_sector);
      End;
      File_Entry_Status := buffer[directory_index * 16 + 1];
      If Directory_Sector > Start_Directory + 8 Then
         File_Entry_Status := 0;
      If File_Entry_Status = 0 Then
         Get_Next := False
      Else If File_Entry_Status < 128 Then Begin
         Get_Next := True;
         entry[0] := chr(16);
         For I := 1 to 16 Do
            entry[i] := Chr(buffer[Directory_Index * 16 + I]);
      End;
      Directory_Index := succ(Directory_Index);
   Until
      File_Entry_Status < 128;
End;

Function Open(Fn : Lstring ; Var File_Entry : Lstring) : Boolean;

Var
   Ext       : Lstring;
   More      : Boolean;
   Dot       : Integer;

Begin    { Open }
   Dot := Pos('.',Fn);
   If Dot = 0 Then
      insert('           ',Fn,length(Fn)+1)
   Else Begin
      ext := copy(Fn,dot+1,3) + '   ';
      delete(Fn,dot,11);
      Fn := Fn + '        ';
      Insert(ext,Fn,9);
   End;
   Fn[0] := Chr(11);
   Directory_Sector := Start_Directory-1;
   Directory_Index := Max_Entries;
   Repeat
      More := Get_Next(File_Entry);
   Until
      (Compare(Copy(File_Entry,6,11),Fn)) or (Not More);
   If More Then Begin
      Open := True;
      Next_File_Sector := Ord(File_Entry[4]) + Swap(Ord(File_Entry[5]));
      File_Entry_Status := File_Entry_Status and $04;
      If Dos_Mode = 0 Then
         Get_Next_File_Sector
      Else Begin
         Get_Sector(Next_File_Sector);
         Move(Buffer[9],File_Map[1],Sector_Size-8);
         Next_File_Sector := File_Map[1] + Swap(File_Map[2]);
         File_Map_Index := 3;
         Last_LJK_Sector_Size := Buffer[6];
         Get_Next_File_Sector;
      End;
      Eof := False;
      Pending_Eof := False;
      End
   Else
      Open := False;
End;

Procedure Readrcd(Var Rcd : Bstring ; Var Rcd_Index : Integer);

Var
   Byt  : Char;

Begin   { Readrcd }
   Rcd_Index := 0;
   If Not Pending_Eof Then
      Repeat
         Byt := Chr(Buffer[File_Sector_Index]);
         File_Sector_Index := Succ(File_Sector_Index);
         If File_Sector_Index > File_Sector_Size Then
            Get_Next_File_Sector;
         If Ord(Byt) <> $9B Then Begin
            Rcd_Index := Succ(Rcd_Index);
            Rcd[Rcd_Index] := Byt;
         End;
      Until
         (Ord(Byt) = $9B) or (Pending_Eof)
   Else
      Eof := True;
End;

Procedure Copy_File;

Var
   Rcd    : Bstring;
   I      : Integer;
   Rcd_Len : Integer;
   Entry,
   Fn     : Lstring;
   Choice : Integer;
   Out_Fn : Text;
   DiskError : Boolean;

Begin     { Copy_File }
   Gotoxy(10,8);  Write('Copy File   ATARI -> IBM');
   Gotoxy(10,12); Write('1: Text Copy');
   Gotoxy(10,14); Write('2: Image Copy');
   Gotoxy(10,19); Write('0: Main Menu');
   Choice := Get_Choice(0,2);
   If Choice <> 0 then
     begin
       Write('Enter File Name: ');
       Readln(Fn);
       If Open(Fn,Entry) Then Begin
          Writeln('Copying : ',Copy(Entry,6,11)); Writeln;
          Assign(Out_Fn,Fn);
          Rewrite(Out_Fn);
          DiskError := false;
          Case Choice Of
             1: Begin
                   Readrcd(Rcd,Rcd_Len);
                   While Not Eof Do Begin
                      If Not Diskio_Error Then Begin
                         For I := 1 to Rcd_Len Do Begin
                            Write(Out_Fn,Rcd[I]);
                         End;
                         Writeln(Out_Fn);
                         Readrcd(Rcd,Rcd_Len); End
                      Else Begin
                         DiskError := True;
                         Eof := True;
                         Write ('There was an error reading the Atari');
                         Writeln (' disk.');
                         Writeln;
                         Write ('This is information about where the ');
                         Writeln ('error occurred.');
                         Display_Status(Next_File_Sector);
                         Close (Out_Fn);
                         Write ('Do you want to erase the file fragment ');
                         Write ('on the IBM disk (Y or N)?');
                         If (Getyn = 'Y')
                           then Begin
                             Erase (Out_Fn);
                             Writeln;
                             Writeln;
                             Writeln ('The file fragment has been erased.')
                           End
                      End;
                   End;
                End;
             2: While Not Pending_Eof Do Begin
                   If Not Diskio_Error Then Begin
                      For I := 1 to File_Sector_Size Do Begin
                         Write(Out_Fn,Chr(Buffer[I]));
                      End;
                      Get_Next_File_Sector; End
                    Else Begin
                      Pending_Eof := True;
                      DiskError := true;
                      Writeln ('There was an error reading the Atari disk.  ');
                      Writeln;
                      Write ('This is information about where the error ');
                      Writeln ('occurred.');
                      Display_Status(Next_File_Sector);
                      Close (Out_Fn);
                      Write ('Do you want to erase the file fragment ');
                      Write ('on the IBM disk (Y or N)?');
                      If (Getyn = 'Y')
                        then Begin
                          Erase (Out_Fn);
                          Writeln;
                          Writeln;
                          Writeln ('The file fragment has been erased.')
                        End
                   End;
                End;
          End;
          If not DiskError then Close(Out_Fn);
          End
       Else
          Writeln(Fn,' Not Found');
       Pause;
   End
End;

Procedure Directory_List;

var
   more  : boolean;
   entry : lstring;
   free,
   times,
   size  : integer;

Begin      { Directory_List }
   Times := 1;
   Directory_Sector := Start_Directory-1;
   Directory_Index := Max_Entries;
   More := Get_Next(Entry);
   While More Do Begin
      Size := Ord(Entry[2]) + Swap(Ord(Entry[3]));
      If Times < 23 Then
         Gotoxy(1,times)
      Else If Times < 45 Then
         Gotoxy(26,Times-22)
      Else
         Gotoxy(51,Times-44);
      Write(Copy(Entry,6,11),'   ',Size:3);
      More  := Get_Next(Entry);
      Times := Succ(Times);
      If (Times > 64) Then
         More := False;
   End;
   If Dos_Mode = 0 Then Begin
      Get_Sector(Start_Directory-1);
      Free := Buffer[4] + Swap(Buffer[5]);
      Gotoxy(1,23); Write(Free:4,' Free Sectors');
   End;
   Pause;
End;

Procedure Dump_Sectors;

Var
   Continue     : Boolean;
   last_sector  : Integer;

Begin
   Continue := True;
   Last_Sector := Start_Directory - 1;
   While Continue Do Begin
      Write('Which Sector: ');
      Dos_Sector := -1;
      {$I-} Readln(Dos_Sector); {$I+}
      If (Ioresult = 0) Then Begin
         If Dos_Sector = -1 Then
            Dos_Sector := Last_Sector + 1;
         Last_Sector := Dos_Sector;
         If Dos_Sector > 0  Then Begin
            Get_Sector(Dos_Sector);
            Display_Status(Dos_Sector);
            If Diskio_Status = 0 Then
               Display_Sector;
         End
         Else
            Continue := False;
      End
      Else
         Clrscr;
   End;
End;

Procedure Configure;

Var
   Choice : Integer;

Begin   { Configure }
   Repeat
      ClrScr;
      Gotoxy(10,3); Write('Configure Disk Parameters');
      Gotoxy(10,7); Write('1: Side ',Disk_Side:1);
      Gotoxy(10,9);
      Case Dos_Mode Of
         0: Write('2: DOS 2.x');
         1: Write('2: LJK DOS');
      End;
      Gotoxy (10,11);
      Case XF551 Of
         0: Write('3: Other Drive');
         1: Write('3: Atari XF551')
      End;
      Gotoxy(10,13);
      Write ('4: Drive ', Char(65+Drive));
      Gotoxy(10,15);
      Write ('5: Text Color Change');
      Gotoxy(10,17);
      Write ('6: Text Background Change');
      Gotoxy(10,22); Write('0: Main Menu');
      Choice := Get_Choice(0,6);
      Case Choice Of
         1: Disk_Side := 3 - Disk_Side;
         2: Begin
               Dos_Mode := 1-Dos_Mode;
               If Dos_Mode = 0 Then Begin
                  Start_Directory := 361;
                  Max_Entries := 8; End
               Else Begin
                  Start_Directory := 257;
                  Max_Entries := 16;
               End;
            End;
         3: XF551 := 1 - XF551;
         4: Begin
                Drive := Drive + 1;
                If Drive > 25 then Drive := 0
            End;
         5: Begin
              ColorText := ColorText + 1;
              If ColorText > 15 then ColorText := 0;
              TextColor (ColorText);
            End;
         6: Begin
              ColorBack := ColorBack + 1;
              If ColorBack > 7 then ColorBack := 0;
              TextBackground (ColorBack)
            End
      End;
   Until
      Choice = 0;
End;

Begin   { Main }
   Init;
   Repeat
      Choice := -1;
      Clrscr;
      Gotoxy(10,5)  ; Write('ATARI -> IBM File Copier');
      Gotoxy(10,6)  ; Write('Version 2.1');
      Gotoxy(10,10) ; Write('1: Dump Sectors');
      Gotoxy(10,12) ; Write('2: Copy File');
      Gotoxy(10,14) ; Write('3: Directory List');
      Gotoxy(10,16) ; Write('4: Configure');
      Gotoxy(10,19) ; Write('0: Exit');
      Choice := Get_Choice(0,4);
      Case Choice Of
         1:  Dump_Sectors;
         2:  Copy_File;
         3:  Directory_list;
         4:  Configure;
      End;
   Until Choice = 0;
   NormVideo;
   ClrScr
End.