program ms2cpm(input,output);

{Program to copy MSDOS/PCDOS disk files to CP/M disk. Written originally
 for Transam Tuscan computer, but modified 23/02/85 for more general use.
 Derek Fordred, 72 Mill Road, Hawley, Dartford, Kent. DA2 7RZ }

       type  dirent = array[1..32] of char;
             dir4   = array[1..4] of dirent;
             pchar  =  ' '..'Z';
             arr128 = array[1..128] of char;
             int360 = 1..360;
              int8  = 1..8;
           datetype = record
                      day : 1..31;
                      mon : 1..12;
                      year: 1980..2099;
                      end;

       label 100;

       const home   = 7;
             seldsk = 8;
             settrk = 9;
             setsec = 10;
             setdma = 11;
           readdisk = 12;
           resetdsk = 13;

       var dataline : dir4;
             ofile  : text;
            filenam : array[1..8] of char;
            filext  : array[1..3] of char;
         validchars : set of pchar;
               dir  : dirent;
             msrec  : arr128;
               ans  : char;
     idrive,odrive  : string[2];
           drvset   : set of char;
               fat  : array[1..4] of arr128;
            dirrec  : arr128;
            dirsec  : dir4;
             fsize  : real;
              date  : datetype;
     cpmfile,msfile : array[1..14] of char;
      match,result  : boolean;
       nsects,x,y,z : integer;
soffset,offset,dtype,disk,track,spt,sector,status,dirsecs : byte;
fatsize,clustersize : 1..2;
      trkdir,secdir : 1..64;
      sectorstocopy : 1..8;
startcluster,oldcluster,newcluster : int360;

procedure copyright;
begin
     writeln('(c) 1985 Derek P.Fordred');
end;

procedure msread(disk,track,sector:byte;var data:arr128);
begin
     bios(seldsk,disk);
     bios(settrk,track);
     bios(setsec,sector);
     bios(setdma,addr(data));
     bios(readdisk,status);
end;

function firstsec(disk:byte):byte;
var dph,i : integer;
begin
    i := bioshl(seldsk,disk);
    dph:=mem[i]+256*mem[i+1];
    if dph<>0 then
        firstsec := mem[mem[i] + 256*mem[i+1]]
    else
        firstsec := 0;
end;

function min(int1,int2:integer):integer;
begin
   if(int1<int2) then
       min:=int1
   else
       min:=int2;
end;

procedure clustrans(cluster:int360; var sector,track:byte);
var  secnum : integer;
begin
    secnum := 4*cluster*clustersize + soffset;
    sector := (secnum mod spt) + offset;
    track  := secnum div spt;
end;

function nextclust(cluster:int360):int360;
var temp,clustnum:integer; clustsec : 1..4;
begin
   clustnum := trunc(cluster*1.5)+1;
   clustsec:=((clustnum-1) div 128) + 1;
   clustnum:=(clustnum-128*(clustsec-1));
   temp := integer(fat[clustsec,clustnum])
                 +256*integer(fat[clustsec,clustnum+1]);
   if odd(cluster) then
        temp := temp div 16
   else
        temp := temp and $0fff;
   case temp of
        2..360      : nextclust := temp;
       $0ff0..$0fff : nextclust := 0;
   else nextclust := 1;
   end;{case}
end;

procedure copycluster(clusternum:int360;nsects:int8);
var x,sectorstoread:integer;
       sector,track:byte;
             buffer:array[1..8] of arr128;
begin
    if clusternum >= 2 then
       begin
          if nsects>0 then
             begin
                clustrans(clusternum,sector,track);
                for x:=1 to nsects do
                   begin
                      msread(disk,track,sector,buffer[x]);
                      sector := sector+1;
                      if sector >= (spt+offset) then
                         begin
                            sector:=offset;
                            track := track+1;
                         end;
                  end;
               for x:=1 to nsects do
                  write(ofile,buffer[x]);
            end;
       end;
end;

{main program}
begin
     clrscr;
     drvset:=['A'..'P'];
     writeln('*********** MSDOS TO CP/M FILE COPY ************');
     copyright;
     writeln;
     write('Which drive contains the MSDOS disk? ');read(idrive);
     idrive[2]:=':';
     idrive[1]:=upcase(idrive[1]);
     if idrive[1] in drvset then disk:=ord(idrive[1])-65
          else disk:=0;
     writeln;
     write('Which drive contains the CP/M disk? ');read(odrive);
     odrive[2]:=':'; odrive[1]:=upcase(odrive[1]);
     writeln;
     writeln('Put MSDOS disk in drive ',idrive,' and CP/M disk in drive ',odrive);
     writeln('Hit return key when ready ');readln;
     bdos(resetdsk); {reset disk system}
     bios(home);
     track:=0;
     offset := firstsec(disk);
     for x:=1 to 4 do
        msread(disk,track,x+offset+3,fat[x]);
     dtype := ord(fat[1,1]);
     write('Disk type is ');
     case dtype of
          255 : begin
                   writeln('Double Sided 8 sectors/track');
                   spt:=64;
                   dirsecs := 7;
                   fatsize := 1;
                   clustersize := 2;
                end;
          254 : begin
                   writeln('Single Sided 8 sectors/track');
                   spt:=32;
                   dirsecs := 4;
                   fatsize := 1;
                   clustersize := 1;
                end;
          253 : begin
                   writeln('Double Sided 9 sectors/track');
                   spt:=36;
                   dirsecs := 7;
                   clustersize := 2;
                   fatsize := 2;
                end;
          252 : begin
                   writeln('Single Sided 9 sectors/track');
                   spt:=36;
                   dirsecs := 4;
                   clustersize := 1;
                   fatsize := 2;
                end;
     else
          writeln('not a valid IBM PC format');halt;
     end;
     writeln;
     writeln('  MSDOS            File       Start     Date ');
     writeln('File Name       Size(bytes)  Cluster   Written');
     writeln('===============================================');
     soffset := (fatsize*2+1+dirsecs-2*clustersize)*4;
     secdir := (fatsize*2+1)*4+offset;
     secdir := secdir-1;
     validchars := [' '..'Z'];
     trkdir:=0;
     repeat
         secdir := secdir+1;
         if secdir >= (spt+offset) then
            begin
               secdir := offset;
               trkdir:= trkdir+1;
            end;
         msread(disk,trkdir,secdir,msrec);
         for x:= 1 to 4 do
             begin
                z := 32*(x-1);
                for y:=1 to 32 do
                   dataline[x][y]:= msrec[z+y];
             end;
         for z:=1 to 4 do
            begin
               dir := dataline[z];
               if (dir[1] in validchars) then
                  begin
                     gotoxy(1,13);
                     for x:= 1 to 8 do
                           filenam[x]:= dir[x];
                     for x:= 9 to 11 do
                           filext[x-8]:= dir[x];
                     write(filenam,'.',filext);
                     fsize:= 0.0;
                     for x:= 32 downto 29 do
                           fsize:= 256*fsize+integer(dir[x]);
                     write(fsize:12:0);
                     startcluster:= integer(dir[27])+256*integer(dir[28]);
                     write(startcluster:9);
                     date.day := integer(dir[25]) and 31;
                     date.mon := (integer(dir[25]) shr 5) +
                                 (integer(dir[26]) and 1) shl 3;
                     date.year:= (integer(dir[26]) shr 1);
                     writeln(date.day:6,'/',date.mon:2,'/',date.year+1980:4);
                     gotoxy(3,15);
                     write('[C]opy, [N]ext or [Q]uit?  ',chr(8));read(ans);
                     case ans of
                     'Q','q'  : begin
                                    writeln;
                                    writeln;
                                    writeln;
                                    halt;
                                end;
                     'C','c' :  begin
                                   cpmfile:='              ';
                                   x:=1;
                                   while (x<=8) and (filenam[x] > ' ') do
                                      begin
                                         cpmfile[x] := filenam[x];
                                         x:=x+1;
                                      end;
                                   cpmfile[x]:='.';
                                   for y:=1 to 3 do
                                      cpmfile[x+y]:=filext[y];
                                   gotoxy(3,17);
                                   write('Copying file: ',cpmfile,'   ');
                                   assign(ofile,odrive[1]+':'+cpmfile);
                                   rewrite(ofile);
                                   nsects:=trunc(fsize/128);
                                   if fsize > nsects*128 then
                                        nsects:=nsects+1;
                                   sectorstocopy:=min(nsects,clustersize*4);
                                   copycluster(startcluster,sectorstocopy);
                                   oldcluster:=startcluster;
                                   nsects:=nsects-sectorstocopy;
                                   while nsects > 0 do
                                      begin
                                         newcluster := nextclust(oldcluster);
                                         sectorstocopy:=min(nsects,clustersize*4);
                                         copycluster(newcluster,sectorstocopy);
                                         oldcluster:=newcluster;
                                         nsects:=nsects-sectorstocopy;
                                      end;
                                   close(ofile);
                                end;
                     'N','n'  :
                     end {case};
               end;
       end;
until (msrec[1]=chr(0)) or (secdir=(fatsize*2+1+dirsecs)*4);
writeln;writeln;writeln;writeln;
end.