unit fdc_util;

interface

uses
 crt;

const
  MaxTimeOut = 80;
  SRA  = $3F0;
  SRB  = $3F1;
  DOR  = $3F2;
  TDR  = $3F3;
  MSR  = $3F4;
  DSR  = $3F4;
  FIFO = $3F5;
  DIR  = $3F7;
  CCR  = $3F7;

procedure Send_Byte(wert:byte);
function Read_Byte : byte;
function Data_Ready : boolean;
function Wait_FDC : string;

procedure Send_Str(str : string);
procedure Reset_FDC;
procedure Motor_ON;
procedure Motor_OFF;
procedure Enable_SRB;
procedure SeekTrk(trk,hd : byte);
procedure Recalibrate;
procedure Set_DataRate(nr:byte);
function SetHeadNr(Nr : byte) : string;

implementation

procedure Send_Byte(wert:byte);

var
  TimeOut : byte;
  Status  : byte;

begin
  TimeOut := MaxTimeOut;
  while (TimeOut > 0) do
  begin
    Status  := PORT[MSR];
    if (Status and $C0) = $80 then
    begin
      PORT[FIFO] := wert;
      exit;
    end;
    delay(1);
    dec(TimeOut);
  end;
  writeln('Time Out Error !');
  halt(1);
end;

procedure Send_Str(str : string);

var
  i : word;

begin
  for i := 1 to ord(Str[0]) do
    Send_Byte(ord(Str[i]));
end;

function Read_Byte : byte;

var
  TimeOut : byte;
  Status  : byte;

begin
  TimeOut := MaxTimeOut;
  while (TimeOut > 0) do
  begin
    Status  := PORT[MSR];
    if (Status and $C0) = $C0 then
    begin
      Read_Byte := PORT[FIFO];
      exit;
    end;
    delay(1);
    dec(TimeOut);
  end;
  writeln('Time Out Error !');
  halt(1);
end;

function Data_Ready : boolean;

begin
  Data_Ready := ((PORT[MSR] and $C0) = $C0);
end;

function Wait_FDC : string;

var
  Ergebnis : string;
  Status   : byte;

begin
  Ergebnis := '';
  while (TRUE) do
  begin
    Status  := PORT[MSR];
    if (Status and $C0) = $80 then
    begin
      Wait_FDC := Ergebnis;
      exit;
    end;
    if (Status and $C0) = $C0 then
      Ergebnis := Ergebnis + CHR(Read_Byte);
  end;
end;

procedure Reset_FDC;

begin
  PORT[DOR] := $10;
  DELAY(50);
  PORT[DOR] := $1C;
  DELAY(50);
end;

procedure Motor_ON;

begin
  PORT[DOR] := $1C;
  DELAY(200);
end;

procedure Motor_OFF;

begin
  PORT[DOR] := $0C;
  DELAY(200);
end;

procedure Enable_SRB;

var
  TempStr : STRING;

begin
  Send_Byte($2E);  {Save Status}
  TempStr := Wait_FDC;
  if TempStr = chr(128) then
  begin
    writeln('Save not supported, you lose !');
    halt(1);
  end;
  TempStr[13] := char(ord(TempStr[13]) or $20);
  Send_Byte($4E); {Restore Status}
  Send_Str(TempStr);
end;

procedure SeekTrk(trk,hd : byte);

begin
  Send_Byte($0F);
  Send_Byte((hd and 1) shl 2);
  Send_Byte(trk);
  Wait_FDC;
end;

procedure Recalibrate;

begin
  Send_Byte($07);
  Send_Byte($00);
  Wait_FDC;
end;

procedure Set_DataRate(nr:byte);

begin
  PORT[DOR] := (nr and $3);
end;

function SetHeadNr(Nr : byte) : string;

begin
  Send_Byte($4A);
  Send_Byte((Nr and 1) shl 2);
  SetHeadNr := Wait_FDC;
end;

end.