program ReadADF; {ver. vom 25.8.1998 Christian K”nig}

{Alles ist Marke Q&D !!! ;-) !!!}

uses
  crt,dos,fdc_util;

const
  TestMode : boolean = false;
  Extended : boolean = false;
  PRTPort  : word    = $378;
  PRTIrq   : byte    = 7;
  PRTShift : byte    = 0;
  Mark1    : word    = 0;
  Mark2    : word    = 0;
  Mark3    : word    = 0;
  FileName : string  = 'DISK.ADF';

type
  TCRC = array[0..3] of byte;
  TBuffer = array[0..$FFFE] of byte;
  PBuffer = ^TBuffer;
  TInfoHeader = record
                  Formatkenzeichen    : byte;
                  Tracknummer         : byte;
                  Sektornummer        : byte;
                  Sektoren_bis_luecke : byte;
                  BlockCRCMFM         : TCRC;
                  BlockCRCDecode      : TCRC;
                  DataCRCMFM          : TCRC;
                  DataCRCDecode       : TCRC;
                end;

var
  Buffer      : PBuffer;
  OFile       : FILE;

procedure Cli; inline($FA);
procedure Sti; inline($FB);

{!Data Seperator! Timing Timing Timing---------------------------------------}

procedure NewPrtInt; assembler;

asm
  mov bp,sp
  shr ax,cl
  test ah,ah
  jz @Weiter1
  mov al,$FF
  @Weiter1:
  stosb
  mov word ptr [bp],0
  cmp di,$FFFE
  jz  @StopMe
  @Return:
  mov al,$20
  out $20,al
  mov ax,0
  iret

  @StopMe:
  mov al,$FF
  out $21,al
  mov [bp],si
  mov [bp+2],cs
  jmp @Return
end;

procedure ReadBuffer(Buffer : PBuffer);

var
  OldPort21   : byte;
  OldPrtInt   : pointer;
  BufferCode   : pointer;
  i           : word;

begin
  GetMem(BufferCode,$FFFF);
  for i := 0 to $FFFF do
    mem[SEG(BufferCode^):i] := $40;
  Cli;
  GetIntVec(PrtIRQ+8,OldPrtInt);
  SetIntVec(PrtIRQ+8,@NewPrtInt);

  OldPort21       := port[$21];
  port[$21]       := (1 shl PrtIRQ) xor $FF;
  port[PRTPort+2] := $10;

  asm
    push bp
    les di,Buffer
    mov ax,0
    mov cl,[PRTShift]
    mov bx,offset BufferCode
    add bx,bp
    mov si,offset @Weiter
    sti
    jmp dword ptr [ss:bx]
    @Weiter:
    cli
    pop bp
  end;

  port[$21]  := OldPort21;
  SetIntVec(PrtIRQ+8,OldPrtInt);
  Sti;
  FreeMem(BufferCode,$FFFF);
end;

{!Auswertung!----------------------------------------------------------------}

const
  FileCount : word = 0;

procedure EvalBuffer(Buffer : PBuffer);

var
  i,k,m,n   : word;
  Temp      : array[0..$FF] of word;
  MaxTemp   : word;
  bild      : array[0..199,0..319] of byte absolute $A000:0000;
  TFile     : File;

begin

  for i := 0 to $FF do
    Temp[i] := 0;

  for k := 0 to $FFFE do
    inc(Temp[Buffer^[k]]);

  MaxTemp := 0;
  for i := 0 to $FF do
  begin
    if Temp[i] > MaxTemp then
      MaxTemp := Temp[i];
  end;

  for i := 0 to $FF do
    Temp[i] := Trunc(Temp[i] / MaxTemp * 199);

  k := 0;
  m := 0;
  for i := 1 to $FF do
  begin
    if (Temp[i] = 0) and (Temp[i-1] <> 0) then
      k := i;
    if (Temp[i] <> 0) and (Temp[i-1] = 0) then
      if (i-k) > m then
        m := i - k;
  end;

  for i := (m DIV 10) to $FF - (m DIV 10) do
    if (Temp[i] = 0) then
    begin
      n := 0;
      for k := i-(m DIV 10) to i do
        if (Temp[k] <> 0) then
          n := 1;
      if (n = 1) then
        for k := i to i+(m DIV 10) do
          if (Temp[k] <> 0) then
            n := 2;
      if (n = 2) then
        Temp[i] := 1;
    end;

{--------------------------------------------------------------------------}
  i := 0;
  while (Temp[i] = 0) do inc(i);
  m := i;
  k := 0;
  while (Temp[i] <> 0) and (i < $FF) do
  begin
    if (Temp[i] > k) then
      k := Temp[i];
    inc(i);
  end;
  for n := m to (i-1) do
    Temp[n] := k;

  while (Temp[i] = 0) do inc(i);
  m := i;
  k := 0;
  while (Temp[i] <> 0) and (i < $FF) do
  begin
    if (Temp[i] > k) then
      k := Temp[i];
    inc(i);
  end;
  for n := m to (i-1) do
    Temp[n] := k;

  while (Temp[i] = 0) do inc(i);
  m := i;
  k := 0;
  while (Temp[i] <> 0) and (i < $FF) do
  begin
    if (Temp[i] > k) then
      k := Temp[i];
    inc(i);
  end;
  for n := m to (i-1) do
    Temp[n] := k;

{--------------------------------------------------------------------------}

  k := 1;
  repeat
    n := 0;
    i := 0;
    while (i < $FF) do
    begin
      if Temp[i] > k then
      begin
        inc(n);
        while (Temp[i] > k) and (i < $FF) do
          inc(i);
      end;
      inc(i);
    end;
    inc(k);
  until (n <= 3);
  dec(k);

  for i := 0 to $FF do
    if Temp[i] <= k then
      Temp[i] := 0;

  i := 0;
  while (Temp[i] = 0) do inc(i);

  while (Temp[i] <> 0) and (i < $FF) do inc(i);
  m := i;
  while (Temp[i] = 0) and (i < $FF) do inc(i);
  Mark1 := m + ((i-m) div 2);

  while (Temp[i] <> 0) and (i < $FF) do inc(i);
  m := i;
  while (Temp[i] = 0) and (i < $FF) do inc(i);
  Mark2 := m + ((i-m) div 2);

  i := $FF;
  while (Temp[i] = 0) do dec(i);
  Mark3 := i+1;

  if (TestMode) then
  begin

    assign(TFile,'PIC'+CHR(FileCount+ORD('0'))+'.DAT');
    rewrite(TFile,1);

    asm
      mov ax,0013h
      int 10h
    end;
    for i := 0 to $FF do
      if Temp[i] <> 0 then
      begin
        for m := 0 to Temp[i] do
          bild[199-m,i] := 15;
      end  else
        bild[199,i] := 0;

    for i := 0 to 199 do
    begin
      if bild[i,Mark1] = 0 then
        bild[i,Mark1] := 4;
      if bild[i,Mark2] = 0 then
        bild[i,Mark2] := 4;
      if bild[i,Mark3] = 0 then
        bild[i,Mark3] := 4;
    end;

    blockwrite(TFile,bild,sizeof(bild));
    close(TFile);
    inc(FileCount);
{    readln;}
    textmode(CO80);

  end;
end;

var
  MFM_Start  : integer;
  MFM_Stop   : integer;
  MFM_Buffer : array[0..(1089*8-1)] of byte;

{!Der ganze dreckige Rest!---------------------------------------------------}

procedure EvalCmdLine;

var
  i,c,k      : word;
  temp,temp2 : string;

begin
  FileName := ParamStr(1);
  if (ParamCount = 0) or (FileName[1] = '-') then
  begin
    writeln('readadf <filename> -p n -i n -s n -d n');
    writeln('  <filename> Name of the file to write');
    writeln('  -p n       n=LPT Port to use (default LPT1)');
    writeln('  -i n       n=IRQ to use (default 7)');
    writeln('  -e         Reads copyprotected Disks (slow)');
    writeln('  -m s:m1:m2 Manualmode:');
    writeln('             s: the shift depending on the cpu speed (0=90/100,1=133/166,2=200/233 Mhz)');
    writeln('             m1,m2: readmark 1,2 depending on the disk/cpu/board ....');
    writeln('  -t         Testmode:generates some stupid pics');
    writeln('             and saves them to disk. Send this files (PIC*.DAT)');
    writeln('             as e-mail to ChristianK.@t-online.de if');
    writeln('             readadf does not work.');
    writeln;
    writeln('for example readadf disk.adf -p 2 -i 5');
    writeln;
    halt(1);
  end;
  for i := 2 to ParamCount do
  begin
    if ParamStr(i) = '-p' then
    begin
      if (ParamStr(i+1) = 'LPT1') or (ParamStr(i+1) = '1') then
        PRTPort := MEMW[$40:$8];
      if (ParamStr(i+1) = 'LPT2') or (ParamStr(i+1) = '2') then
        PRTPort := MEMW[$40:$A];
      if (ParamStr(i+1) = 'LPT3') or (ParamStr(i+1) = '3') then
        PRTPort := MEMW[$40:$C];
      if (ParamStr(i+1) = 'LPT4') or (ParamStr(i+1) = '4') then
        PRTPort := MEMW[$40:$E];
    end;
    if ParamStr(i) = '-i' then
    begin
      temp := ParamStr(i+1);
      PRTIrq := ord(temp[1])-ord('0');
    end;
    if ParamStr(i) = '-t' then
      Testmode := true;
    if ParamStr(i) = '-e' then
      Extended := true;
    if ParamStr(i) = '-m' then
    begin
      temp  := ParamStr(i+1);
      k := 1;
      temp2 := '';
      while (k <= length(temp)) and (temp[k] <> ':') do
      begin
        temp2 := temp2 + temp[k];
        inc(k);
      end;
      val(temp2,PRTShift,c);
      temp2 := '';
      inc(k);
      while (k <= length(temp)) and (temp[k] <> ':') do
      begin
        temp2 := temp2 + temp[k];
        inc(k);
      end;
      val(temp2,Mark1,c);
      temp2 := '';
      inc(k);
      while (k <= length(temp)) and (temp[k] <> ':') do
      begin
        temp2 := temp2 + temp[k];
        inc(k);
      end;
      val(temp2,Mark2,c);
      Mark3 := $FF;
    end;
  end;
end;

var
  trk_hd  : integer;
  adf_id  : string;
  i       : word;

{$I DECODSTD.PAS}
{$I DECODEXT.PAS}

begin
  EvalCmdLine;
  clrscr;
  Randomize;
  Reset_FDC;
  Motor_ON;
  Recalibrate;
  delay(200);
  Recalibrate;
  delay(200);

  GetMem(Buffer,$FFFF);

  if Mark3 = 0 then
  begin
    repeat
      ReadBuffer(Buffer);
      EvalBuffer(Buffer);
      inc(PrtShift);
    until (Mark3 < $FF);
    dec(PrtShift);
  end;

  assign(OFile,FileName);
  rewrite(OFile,1);

  if Extended then
  begin
    adf_id := 'UAE--ADF';
    blockwrite(OFile,adf_id[1],8);
    for trk_hd := 0 to 159 do
    begin
      i := 0;
      blockwrite(OFile,i,2);
      i := 512*11;
      i := swap(i);
      blockwrite(OFile,i,2);
    end;
    seek(OFile,160*4+8);
  end;

  for trk_hd := 0 to 159 do
  begin
    if WriteDiskStd = 0 then
      if Extended then
        WriteDiskExt;
  end;

  close(OFile);
  FreeMem(Buffer,$FFFF);

  Recalibrate;
  delay(200);
  Recalibrate;
  delay(200);
  Reset_FDC;
  Motor_OFF;
  clrscr;
end.