Program CAPV12;
{Convert Atmos to PC V 1.2
Copyright Robert Ch‚ramy 1995, 1995
Ce source n'est pas un exemple de programmation rigoureuse... Il permettra
tout au plus au curieux d'essayer de comprendre son fonctionnement.
Vous pouvez r‚utiliser tout ou partie de ce source (pour une utilisation
personnelle ou une distribution GRATUITE) si vous citez sa provenance et avez
la gentillesse de m'‚crire un mot:

Robert Ch‚ramy
54, rue de Sours
28000 CHARTRES
FRANCE
E-mail : cheramy@citi2.fr

Si vous avez des questions, je serais heureux d'y r‚pondre.
Certaines variables sont devenues obsolŠtes et innutilis‚es au cours des
nouvelles versions, et certaines parties du source sont peut-ˆtre inutiles,
je n'ai eu ni le temps ni le courage de m'y attaquer... Je l'ai dit et le
r‚pŠte: ce programme est vraiment trŠs mal con‡u...
}
uses dos,crt;
type T_dbt = array[0..$A] of byte;
var Old,p  : pointer;
    olddbt : ^T_dbt;
    dbt    :     T_dbt;
    buff,buff1 : array[0..255] of byte;
    drive      : byte;
    pist       : byte;
    sect       : byte;
    reg        : registers;
    fic,st     : string;
    Pcfic      : string;
    Pcfic2     : string;
    f          : file;
    face       : byte;
    nb         : byte;
    i,j,k      : word;
    sortir     : boolean;
    ent        : array[1..26] of byte;
    ch         : char;
    rep        : DirStr;
    Nomfic     : NameStr;
    Extension  : ExtStr;
    newfile    : string;
    essais     : word;
    carry      : Word;

Procedure InitDK;
begin
reg.ah:=0;
reg.dl:=Drive;
intr($13,reg);
end;

Procedure Charge(pos:byte);
Begin;
 Fic[0]:=#13;
 For J:=0 to 8 do Fic[J+1]:=chr(buff[pos shl 4 + J]);
 Fic[10]:='.';
 For J:=0 to 2 do Fic[J+11]:=chr(buff[pos shl 4 + 9 + J]);
 Writeln('Transfert du fichier ',fic,' (le fichier destination, s''il existe');
 Writeln('d‚ja, sera ‚cras‚');
 Pcfic[0]:=#12;
 For J:=1 to 8 do Pcfic[J]:=fic[J];
 For J:=1 to 4 do Pcfic[J+8]:=fic[J+9];
 Writeln('Fichier destination? (Par d‚faut, ',Pcfic,' )');
 Read (Pcfic2);
 if Pcfic2='' then Pcfic2:=pcfic;

 InitDK;
 essais:=5;
 repeat
  reg.ah:=2;
  reg.al:=1;                               {1secteur}
  reg.ch:=buff[pos shl 4 +$c] and $7f;     {piste}
  reg.cl:=buff[pos shl 4 +$d] ;            {secteur}
  reg.dh:=buff[pos shl 4 +$c] shr 7;       {face}
  reg.dl:=Drive;
  reg.es:=seg(buff);
  reg.bx:=ofs(buff);
  intr($13,reg);
  carry:=reg.flags and fcarry;
  if carry=1 then begin initDK; dec(essais); end;
 until (carry=0) or (essais=0);
 if essais=0 then begin
  setintvec($1e,old);
  InitDK;
  Write('ProblŠme de lecture Face ',buff[pos shl 4 +$c] shr 7,' Piste ');
  Writeln(buff[pos shl 4 +$c] and $7f,' Secteur ',buff[pos shl 4 +$d]);
  Halt;
  end;
 assign(f,pcfic2);
 rewrite(f,1);
{Ecriture de l'en tˆte}
 for K:=1 to 3 do ent[K]:=$16;
 ent[4]:=$24;
 ent[5]:=$00;
 ent[6]:=$00;
 if (buff[3] = $80) or (buff[3]=$81) then ent[7]:=$00 else ent[7]:=$80;
 ent[8]:=00;
 ent[9]:=buff[7];
 ent[10]:=buff[6];
 ent[11]:=buff[5];
 ent[12]:=buff[4];
 ent[13]:=00;
 FSplit(Pcfic2,rep,NomFic,Extension);
 If extension='.' then extension:='';
 Newfile:=Nomfic+Extension;
 For I:=1 to length(Newfile) do ent[13+i]:=ord(Newfile[i]);
 ent[14+i]:=00;
 blockwrite(f,ent,i+14);

 Sortir:=false;
 i:=$c;
  Repeat
   essais:=5;
   repeat
   reg.ah:=2;
   reg.al:=1;      {1secteur}
   reg.ch:=buff[i] and $7f;     {pist}
   reg.cl:=buff[i+1];     {sect}
   reg.dh:=buff[i] shr 7;           {face}
   reg.dl:=Drive;
   reg.es:=seg(buff1);
   reg.bx:=ofs(buff1);
   intr($13,reg);
   carry:=reg.flags and fcarry;
   if carry=1 then begin initDK; dec(essais); end;
   until (carry=0) or (essais=0);
   if essais=0 then begin
    setintvec($1e,old);
    InitDK;
    Write('ProblŠme de lecture Face ',buff[i] shr 7,' Piste ');
    Writeln(buff[i] and $7f,' Secteur ',buff[i+1]);
    Halt;
    end;
   blockwrite(f,buff1,256);
   i:=i+2;
  until ((buff[i]=0) and (buff[i+1]=0)) or (i>$ff);
  if i>$ff then begin
   essais:=5;
   repeat
   reg.ah:=2;
   reg.al:=1;                   {1 secteur}
   reg.ch:=buff[0] and $7f;     {pist}
   reg.cl:=buff[1];             {sect}
   reg.dh:=buff[0] shr 7;       {face}
   reg.dl:=Drive;
   reg.es:=seg(buff);
   reg.bx:=ofs(buff);
   intr($13,reg);
   carry:=reg.flags and fcarry;
   if carry=1 then begin initDK; dec(essais); end;
   until (carry=0) or (essais=0);
   if essais=0 then begin
    setintvec($1e,old);
    InitDK;
    Write('ProblŠme de lecture Face ',buff[0] shr 7,' Piste ');
    Writeln(buff[0] and $7f,' Secteur ',buff[1]);
    Halt;
    end;
  repeat
 i:=$2;
  Repeat
   essais:=5;
   repeat
   reg.ah:=2;
   reg.al:=1;                   {1 secteur}
   reg.ch:=buff[i] and $7f;     {pist}
   reg.cl:=buff[i+1];           {sect}
   reg.dh:=buff[i] shr 7;       {face}
   reg.dl:=Drive;
   reg.es:=seg(buff1);
   reg.bx:=ofs(buff1);
   intr($13,reg);
   carry:=reg.flags and fcarry;
   if carry=1 then begin initDK; dec(essais); end;
   until (carry=0) or (essais=0);
   if essais=0 then begin
    setintvec($1e,old);
    InitDK;
    Write('ProblŠme de lecture Face ',buff[i] shr 7,' Piste ');
    Writeln(buff[i] and $7f,' Secteur ',buff[i+1]);
    Halt;
    end;
  blockwrite(f,buff1,256);
   i:=i+2;
  until ((buff[i]=0) and (buff[i+1]=0)) or (i>$ff);
  if i>$ff then begin
   essais:=5;
   repeat
   reg.ah:=2;
   reg.al:=1;                   {1secteur}
   reg.ch:=buff[0] and $7f;     {pist}
   reg.cl:=buff[1];             {sect}
   reg.dh:=buff[0] shr 7;       {face}
   reg.dl:=Drive;
   reg.es:=seg(buff);
   reg.bx:=ofs(buff);
   intr($13,reg);
   carry:=reg.flags and fcarry;
   if carry=1 then begin initDK; dec(essais); end;
   until (carry=0) or (essais=0);
   if essais=0 then begin
    setintvec($1e,old);
    InitDK;
    Write('ProblŠme de lecture Face ',buff[0] shr 7,' Piste ');
    Writeln(buff[0] and $7f,' Secteur ',buff[1]);
    Halt;
  end;
   end
  else begin
   sortir:=true;
   end;
 until sortir;
end;
close(f);
buff[0]:=20;
buff[1]:=4;
{Writeln('Continuer?');
Readln(ch);
if ((ch=#14) or (ch=#13)) then nb := 16;}
end;



Begin
 Drive:=0;
 Writeln('Convert Atmos to PC V. 1.2  by Robert Cheramy');
 Writeln('Ce petit programme a pour but de transf‚rer des fichiers d''une');
 Writeln('disquette S‚doric (lecteur A par defaut) sur votre disque dur, au');
 Writeln('format CLOAD prˆt … l''emploi pour EUPHORIC (l''‚mulateur oric de');
 Writeln('Fabrice FrancŠs, que je salue et f‚licite au passage...)');
 Writeln;
 Writeln('This program converts files from a Sedoric floppy (A is default)');
 Writeln('to your hard drive, with a CLOAD header, ready to use for EUPHORIC');
 Writeln;
 Writeln('Usage / Use:');
 Writeln('CAP [Drive]');
 Writeln('Drive : A or B; A is default');

 st:=paramstr(1);
 ch:=st[1];
 If Paramcount >= 1 then
  If Paramcount > 1 then halt
   else
    case upcase(ch) of
     'A' : Drive:=0;
     'B' : Drive:=1;
     else halt;
    end;
 Writeln;
 If drive=1 then Writeln('Drive B chosen')
  else Writeln('Drive A will be used');
 Writeln('Inserez une disquette Sedoric et appuyez sur entr‚e pour continuer');
 Writeln('Insert a sedoric floppy in you drive, then press Enter');
 Readln(st);

 getintvec($1E,old);
 olddbt:=old;
 dbt:=olddbt^;
 dbt[3]:=1;
 buff[0]:=20;
 buff[1]:=4;
 setintvec($1e,@dbt);
 initdk;
 Repeat
  essais:=5;
  Repeat
  reg.ah:=2;
  reg.al:=1;      {1secteur}
  reg.ch:=buff[0] and $7F;     {pist}
  reg.cl:=buff[1];      {sect}
  reg.dh:=buff[0] shr 7;      {face}
  reg.dl:=Drive;
  reg.es:=seg(buff);
  reg.bx:=ofs(buff);
  intr($13,reg);
  carry:=reg.flags and fcarry;
  if carry=1 then begin initDK; dec(essais); end;
  until (carry=0) or (essais=0);
  if essais=0 then begin
   setintvec($1e,old);
   InitDK;
   Write('ProblŠme de lecture Face ',buff[0] shr 7,' Piste ');
   Writeln(buff[0] and $7f,' Secteur ',buff[0]);
   Halt;
   end;

  if buff[2]=0 then
   For I:= 1 to $F do begin
    Fic[0]:=#13;
    For J:=0 to 8 do Fic[J+1]:=chr(buff[I shl 4 + J]);
    Fic[10]:='.';
    For J:=0 to 2 do Fic[J+11]:=chr(buff[I shl 4 + 9 + J]);
    writeln(I,' ',Fic);
   end
    else if buff[2]=10 then else begin
     For I:=1 to (buff[2] shr 4-1) do begin
      For J:=0 to 8 do Fic[J+1]:=chr(buff[I shl 4 + J]);
      Fic[10]:='.';
      For J:=0 to 2 do Fic[J+11]:=chr(buff[I shl 4 + 9 + J]);
      Writeln(I,' ',fic);
     end;
   end;
  if (buff[0]=0) and (buff[1]=0) then begin
   buff[0]:=20;
   buff[1]:=4;
  end;
  Writeln('16 pour Quitter');
  Writeln('0  : suite');
  Readln(nb);
  case nb of
   1..15 : charge(nb);
  end;
 Until nb=16;
 Setintvec($1e,old);
 InitDK;
end.