home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / emulator / cpc / cpcread.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-09-14  |  6.0 KB  |  269 lines
  1. {$R+}
  2. program CPCREAD;
  3. { Marco Vieth, 26.9.1992 }
  4. {Reads CPC-Disks to a File  (only Side A) }
  5. {40 Track, Data-Format}
  6.  
  7. uses dos; {fuer intr}
  8.  
  9. const
  10.   MAXHD = 0;  {nur Head 0}
  11.  
  12. type
  13.   regpack = registers; {>=TP4.0}
  14.         {TP3.0:
  15.             record
  16.               ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  17.             end;
  18.         }
  19.   medium = RECORD
  20.              drive  : byte;
  21.              head   : byte;
  22.              track  : byte;
  23.              sektor : byte;
  24.              sanz   : byte; {Sektoranzahl}
  25.            end;
  26.  
  27.   format = RECORD
  28.              FSC : byte; {First Sector}
  29.              PST : byte; {physik. Sectoren pro Track}
  30.              LTRK : byte; {letzter Track}
  31.              BSEC : integer; {Bytes pro Sector}
  32.            end;
  33.  
  34.   secdat = array[0..$1FF] of byte;
  35.   trkdat = array[0..8] of secdat;
  36.  
  37. var
  38.   qfor : format;
  39.   qdrv : medium;
  40.   datbu : trkdat;
  41.  
  42. disk_info : array[0..$ff] of byte;      {disk-info-array}
  43.  
  44. track_info : array[0..$ff] of byte;      {track-info-array}
  45.  
  46.  
  47.  
  48. procedure rsek(was:medium; lw:format; var buffer);
  49. var retry : integer;
  50.     register:regpack;
  51. begin
  52.   retry:=0;
  53.   repeat
  54.  
  55.  {
  56.     writeln('command=',was.command);
  57.     writeln('drive  =',was.drive);
  58.     writeln('head   =',was.head);
  59.     writeln('track  =',was.track);
  60.     writeln('sektro =',was.sektor);
  61.  }
  62.  
  63.     with register do begin
  64.       ax:=$0200 + was.sanz;  {Anz. Sektoren}
  65.       cx:=(was.track shl 8) + (was.sektor or (lw.FSC-1));
  66.       dx:=(was.head shl 8) + was.drive;      {Kopf und Drive}
  67.       es:=seg(buffer);          {DMA-Segment}
  68.       bx:=ofs(buffer);          {DMA-Offset}
  69.     end;
  70.     intr($13,register);
  71.     if (register.ax and $FF00) <> 0 then begin
  72.       retry:=retry + 1;
  73.       if retry>3 then begin
  74.         writeln('Fehler beim Diskettenzugriff Drive ',chr(was.drive+65));
  75.         halt;
  76.       end;
  77.     end;
  78.   until register.ax and $FF00 = 0;
  79. end;
  80.  
  81.  
  82. procedure setformat(var form:format);
  83. begin
  84.   form.FSC:=$C1; {First-Sector}
  85.   form.PST:=9;   {Sectoren pro Track}
  86.   form.LTRK:=39; {last Track}
  87.   form.BSEC:=$200; {Bytes pro Sector}
  88. end;
  89.  
  90. procedure initdrv(var drv:medium; laufw:byte);
  91. begin
  92.   drv.drive:=laufw;
  93.   drv.head:=0;
  94.   drv.track:=0;
  95.   drv.sektor:=0;
  96.   drv.sanz:=1;
  97. end;
  98.  
  99.  
  100. procedure create_disk_info;
  101. const ident:string = 'MV - Z80EMU Disk-File'#13#10'Disk-Info'#13#10;
  102.  
  103. var i:integer;
  104.  
  105. begin
  106.   fillchar(disk_info,$100,0);
  107.   for i:=0 to length(ident) do begin
  108.     disk_info[i] := ord(ident[i+1]);
  109.   end;
  110.   i:=i+14;
  111.   disk_info[i] := 40;    {# tracks}
  112.   i:=i+1;
  113.   disk_info[i] := 1;     {# heads}
  114.   i:=i+1;
  115.   disk_info[i] := 0;     {lo-byte track-size}
  116.   i:=i+1;
  117.   disk_info[i] := $13;     {hi-byte track-size}
  118. end;
  119.  
  120.  
  121. procedure create_track_info(track,head:byte);
  122. const ident:string = 'Track-Info'#13#10;
  123. var i,j : integer;
  124.  
  125. begin
  126.   fillchar(track_info,$100,0);
  127.   for i:=0 to length(ident) do begin
  128.     track_info[i] := ord(ident[i+1]);
  129.   end;
  130.   i:=i+4;
  131.   track_info[i] := track;    {track-number}
  132.   i:=i+1;
  133.   track_info[i] := head;    {head-number}
  134.   i:=i+1;
  135.   i:=i+2;       { 2 bytes not used}
  136.  
  137.   {format-track-parameter}
  138.   track_info[i] := 2;    {BPS}
  139.   i:=i+1;
  140.   track_info[i] := 9;    {# sectors}
  141.   i:=i+1;
  142.   track_info[i] := $4e;    {GAP #3 format}
  143.   i:=i+1;
  144.   track_info[i] := $e5;    {fill-byte}
  145.   i:=i+1;
  146.  
  147.   {sector-data}
  148.   for j:=1 to 9 do begin
  149.     {sector-ID}
  150.     track_info[i] := track;    {track-number}
  151.     i:=i+1;
  152.     track_info[i] := head;    {head-number}
  153.     i:=i+1;
  154.     track_info[i] := j or $c0;       {sector}
  155.     i:=i+1;
  156.     track_info[i] := 2;       {BPS}
  157.     i:=i+1;
  158.  
  159.     {errors in sector}
  160.     track_info[i] := 0;       {state 1 errors}
  161.     i:=i+1;
  162.     track_info[i] := 0;       {state 2 errors}
  163.     i:=i+1;
  164.     track_info[i] := 0;       {not used}
  165.     i:=i+1;
  166.     track_info[i] := 0;       {not used}
  167.     i:=i+1;
  168.   end;
  169.  
  170. end;
  171.  
  172.  
  173.  
  174. procedure kopiere(quelle:byte; ziel:string);
  175. var
  176.  trk,hd,sec:byte;
  177.  cfile : file;
  178.  anzahl,writeanz : word;
  179.  
  180. begin
  181.   writeln('Kopiere von ',chr(quelle+65),' nach ',ziel);
  182.   writeln;
  183.  
  184.   assign(cfile,ziel);
  185.   rewrite(cfile);
  186.  
  187.   initdrv(qdrv,quelle);
  188.   setformat(qfor);
  189.  
  190.   create_disk_info;
  191.   blockwrite(cfile,disk_info,2,writeanz);
  192.   if (writeanz=2) then writeln('Disk-Info-Block written.');
  193.  
  194.   for trk:=0 to qfor.LTRK do begin
  195.     write('Lade Track ',trk,' ... ');
  196.     qdrv.track:=trk;
  197.       for sec:=1 to qfor.PST do begin
  198.         qdrv.sektor:=sec;
  199.         qdrv.head:=hd;
  200.         rsek(qdrv,qfor,datbu[sec-1]);
  201.       end;
  202.     write(' ok   -   ');
  203.     write('und ins File  ... ');
  204.       create_track_info(trk,0);
  205.       blockwrite(cfile,track_info,2,writeanz);
  206.       if (writeanz=2) then write('data ... ');
  207.  
  208.       anzahl := qfor.PST*4;
  209.       blockwrite(cfile,datbu,anzahl,writeanz);
  210.       if (anzahl = writeanz) then writeln(' ok.');
  211.   end;
  212.   close(cfile);
  213. end;
  214.  
  215.  
  216. procedure menue;
  217. const
  218.  quelle:byte = 0;
  219.  zielfile: string[40] = 'DISK1.CPC';
  220.  
  221. var ch : char;
  222.     eingabe : string;
  223.  
  224. begin
  225.   repeat
  226.     writeln;
  227.     writeln('CPCREAD (v1.0) ');
  228.     writeln;
  229.     writeln('Kopiert CPC-Disketten in ein File');
  230.     writeln('(im Moment DATA-Format,40 Track, Seite A)');
  231.     writeln;
  232.     writeln('Quellaufwerk : ',chr(quelle+65),'  / Zielfile : ',zielfile);
  233.     writeln;
  234.     writeln('1) Kopieren');
  235.     writeln('2) Quellaufwerk aendern');
  236.     writeln('3) Zielfile aendern');
  237.     writeln('4) Ende');
  238.     writeln;
  239.     writeln('Ihre Wahl : ');
  240.     readln(ch);
  241.     case ch of
  242.      '1' : kopiere(quelle,zielfile);
  243.      '2' :
  244.        begin
  245.          write('Neues Quellaufwerk : ');
  246.          readln(eingabe);
  247.          eingabe[1] := upcase(eingabe[1]);
  248.          if (eingabe[1]>='A') and (eingabe[1]<='E') then quelle := ord(eingabe[1])-65;
  249.        end;
  250.      '3' :
  251.        begin
  252.          write('Neues Zielfile : ');
  253.          readln(eingabe);
  254.          zielfile := eingabe;
  255.        end;
  256.      '4' : ;
  257.      else writeln('Was war das ??');
  258.     end;
  259.   until ch='4';
  260. end;
  261.  
  262.  
  263. begin  {main}
  264.   menue;
  265. end.
  266. {Ende cpcread.pas}
  267.  
  268.  
  269.