(**********************************************************************)
(*                                                                    *)
(* Ph”niX SoftCrew  Turbo Pascal Programme                            *)
(* most (c) by PSC Software Development Lippstadt/Warendorf           *)
(*                                                                    *)
(* Ph”niX SoftCrew          ####   ####  ####                         *)
(* c/o Carsten Strotmann    #   # ##    ##                            *)
(* An der Kreutzbrede 20    ####   ###  ##     Software Development   *)
(*                          #        ## ##                            *)
(* 4410 Warendorf 1         #     ####   ####                         *)
(*                                                                    *)
(**********************************************************************)

(*

  Programmname   :ATARI Kompatibilit„ts Unit
  Filename       :A_UNIT.PAS
  von            :Carsten Strotmann
  letzte Žnderung:06.02.91
  Bemerkung      :

*)

UNIT A_UNIT;

INTERFACE

USES DOS, CRT;

TYPE
  a_sector = RECORD
             CASE INTEGER OF
              1 : ( secdata  : ARRAY [0..252] OF BYTE; { Sektordaten }
                    seclink  : WORD;                   { Link Word }
                    secsize  : BYTE;                   { Anzahl Bytes }
                    dummy    : WORD;
                  );
              2 : ( sectordat: ARRAY [0..$FF] OF BYTE );
             END;

  drivetab = RECORD
              steptime : BYTE; { Schrittzeit }
              dmamode  : BYTE; { DMA Modus }
              motorwait: BYTE; { Motor Nachlaufzeit }
              secbyte  : BYTE; { Bytes pro Sektor }
              sectrack : BYTE; { Max. Anzahl Sek. pro Track }
              secspace1: BYTE; { Zeit zwischen Sektoren }
              notused  : BYTE; { unbenutzt }
              secspace2: BYTE; { Freiraum zwischen Sektoren }
              fillcode : BYTE; { ASCII Code zum f�llen }
              endtime  : BYTE; { Ruhezeit zum Ausschwingen }
              starttime: BYTE; { Anlaufzeit des Motors }
            END;

  filename = RECORD
               name    : ARRAY [0..7] OF CHAR; { Bezeichnung }
               ext     : ARRAY [0..2] OF CHAR; { Extender }
             END;

  direntry = RECORD
               flag    : BYTE;                 { Statusflag }
               length  : WORD;                 { L„nge des Files }
               startsec: WORD;                 { Startsector }
               name    : ARRAY [0..7] OF CHAR; { Bezeichner }
               ext     : ARRAY [0..2] OF CHAR; { Extender }
             END;

  vtoc     = RECORD
               version : BYTE;                   { Dos Version kompat. }
               maxfree : WORD;                   { Max. Sektoren der Disk }
               freesec : WORD;                   { Freie Sektoren }
               table   : ARRAY [0..$FF] OF BYTE; { Sektorenbelegungstabelle }
             END;

VAR
  olddrivetab : POINTER;
  { Zeiger auf alte Tabelle }

  a_drivetab  : drivetab;
  { Neue Laufwerkstabelle }

  a_vtoc      : vtoc;
  { VOLUME TABLE OF CONTENTS }

  a_dir       : ARRAY [1..64] OF direntry;
  { DIRECTORY ARRAY }

  dir_read,
  { Flag f�r Directory schon gelesen }

  vtoc_read   : BOOLEAN;
  { Flag f�r VTOC schon gelesen }

  secprotrk,
  { Sektoren pro Track }
  secsize,
  { SektorengrӇe }
  diskside,
  { Diskettenseite }
  drivenum,
  { Laufwerksnummer }
  entrycount,
  { Eintragsnummer }
  a_error     : BYTE;
  { Fehlernummer }

FUNCTION DiskStatus : BYTE;
{ Ermittelt den Diskstatus }

PROCEDURE DiskReset;
{ F�hrt einen Diskreset aus }

PROCEDURE SetDrive (drive, value : BYTE);
{ Setzt Formatangaben f�r Diskettenlaufwerk }

PROCEDURE SetNewDriveTab (strack, sbyte : BYTE);
{ Installiert neue Laufwerkstabelle }

PROCEDURE SetOldDriveTab;
{ Restauriert alte Laufwerkstabelle }

FUNCTION  Read_A_Sector (drive, side : BYTE; num : WORD; VAR buffer : a_sector): BYTE;
{ Liest einen ATARI Sektor }

FUNCTION  Write_A_Sector (drive, side : BYTE; num : WORD; VAR buffer : a_sector): BYTE;
{ Schreibt einen ATARI Sektor }

PROCEDURE Read_Dir (drive : BYTE);
{ Liest Directory ein }

PROCEDURE Read_VTOC (drive : BYTE);
{ Liest VTOC ein }

FUNCTION A_FindFirst (filen : STRING) : BYTE;
{ Findet ersten Filenamen in Directory und liefert Eintragsnummer zur�ck }

FUNCTION A_FindNext (filen : STRING): BYTE;
{ Findet n„chsten Filenamen in Directory und gibt Eintragsnummer zur�ck }

IMPLEMENTATION

FUNCTION DiskStatus : BYTE;
VAR
  reg : REGISTERS;
BEGIN
  reg.ah := 1;
  Intr ($13,reg);
  DiskStatus := reg.ah;
END;

PROCEDURE DiskReset;
VAR
  reg : REGISTERS;
BEGIN
  reg.ah := 0;
  Intr ($13,reg);
END;

PROCEDURE SetDrive (drive, value : BYTE);
VAR
  reg : REGISTERS;
BEGIN
  reg.ah := $17;
  reg.dl := drive;
  reg.al := value;
  Intr($13,reg);
END;

PROCEDURE SetNewDriveTab (strack, sbyte : BYTE);
BEGIN
  WITH a_drivetab DO
  BEGIN
    steptime := $DF;
    dmamode  := 2;
    motorwait:= $24;
    secbyte  := sbyte;
    sectrack := strack;
    secspace1:= $1B;
    notused  := $FF;
    secspace2:= $10;
    fillcode := $FF;
    endtime  := $F;
    starttime:= 8;
  END;

  GetIntVec ($1E, olddrivetab);
  SetIntVec ($1E, @a_drivetab);

END;

PROCEDURE SetOldDriveTab;
BEGIN
  SetIntVec ($1E, olddrivetab);
END;

FUNCTION Read_A_Sector (drive, side : BYTE; num : WORD; VAR buffer : a_sector): BYTE;
VAR
  reg : REGISTERS;
  track,
  sec,
  bb  : WORD;
  buf : ARRAY [0..$110] OF BYTE;

BEGIN
  IF (num > 0) AND (num < 720) THEN
  BEGIN
    bb := DiskStatus;

    IF bb > 0 THEN
      DiskReset;

    track := num DIV secprotrk;
    sec:= num - (track * secprotrk);
    IF sec = 0 THEN
    BEGIN
      sec := secprotrk;
      Dec (track);
    END;
    reg.ah := 2;        {Sektor lesen}
    reg.al := 1;        {Anzahl der Sektoren}
    reg.dh := side;     {Diskettenseite}
    reg.dl := drive;    {Laufwerk}
    reg.cl := sec;      {erster Sektor}
    reg.ch := track;    {Track des Sektors}
    reg.es := Seg(buf[0]);
    reg.bx := Ofs(buf[0]);
    Intr ($13,reg);

    Read_A_Sector := reg.ah;

    Move (buf,buffer,$100);

    FOR bb := 0 TO $100 DO
      buffer.sectordat[bb] := buffer.sectordat[bb] XOR $FF;
  END;
END;

FUNCTION Write_A_Sector (drive, side : BYTE; num : WORD; VAR buffer : a_sector): BYTE;
VAR
  reg : REGISTERS;
  track,
  sec,
  bb  : WORD;
  buf : ARRAY [0..$110] OF BYTE;

BEGIN
  FOR bb := 0 TO $100 DO
    buffer.sectordat[bb] := buffer.sectordat[bb] XOR $FF;

  Move (buffer,buf,$100);

  IF (num > 0) AND (num < 720) THEN
  BEGIN
    bb := DiskStatus;

    IF bb > 0 THEN
      DiskReset;

    track := num DIV secprotrk;
    sec:= num - (track * secprotrk);
    IF sec = 0 THEN
    BEGIN
      sec := secprotrk;
      Dec (track);
    END;
    reg.ah := 3;        {Sektor schreiben}
    reg.al := 1;        {Anzahl der Sektoren}
    reg.dh := side;     {Diskettenseite}
    reg.dl := drive;    {Laufwerk}
    reg.cl := sec;      {erster Sektor}
    reg.ch := track;    {Track des Sektors}
    reg.es := Seg(buf[0]);
    reg.bx := Ofs(buf[0]);
    Intr ($13,reg);

    Write_A_Sector := reg.ah;

  END;
END;

PROCEDURE Read_Dir (drive : BYTE);
VAR
 u : WORD;
 s : a_sector;

BEGIN
 a_error := 0;
 FOR u := 1 TO 8 DO
 BEGIN
   a_error := Read_A_Sector (drive,diskside,u+360,s);
   Move (s,a_dir[(u-1)*8+1],128);
   IF a_error > 0 THEN
     EXIT;
 END;
 dir_read := TRUE;
 entrycount := 0;
END;

PROCEDURE Read_VTOC (drive : BYTE);
VAR
  s : a_sector;
BEGIN
  a_error := 0;
  a_error := Read_A_Sector (drive,diskside,360,s);
  Move (s,a_vtoc,$80);
  vtoc_read := TRUE;
END;

FUNCTION A_FindNext (filen : STRING): BYTE;
VAR
  u,p : BYTE;
  f : BOOLEAN;
  fn,
  fs : filename;

BEGIN
  FillChar (fn,11,0);

  p := Pos('.',filen);

  FOR u := 1 TO p-1 DO
    fn.name[u-1] := filen[u];

  FOR u := p+1 TO Length(filen) DO
    fn.ext[u-p-1] := filen[u];

  f := FALSE;
 
  FOR u := 0 TO 7 DO
  BEGIN
    IF fn.name[u] = '*' THEN
      f := TRUE;
    IF f THEN
      fn.name[u] := '?';
  END;

  f := FALSE;

  FOR u := 0 TO 2 DO
  BEGIN
    IF fn.ext[u] = '*' THEN
      f := TRUE;
    IF f THEN
      fn.ext[u] := '?';
  END;

  FOR u := 0 TO 7 DO
    IF fn.name[u] = #0 THEN
      fn.name[u] := #32;

  FOR u := 0 TO 7 DO
    IF fn.ext[u] = #0 THEN
      fn.ext[u] := #32;

  REPEAT
    Inc (entrycount);

    FOR u := 0 TO 7 DO
      fs.name[u] := a_dir[entrycount].name[u];

    FOR u := 0 TO 2 DO
      fs.ext[u] := a_dir[entrycount].ext[u];

     FOR u := 0 TO 7 DO
       IF fn.name[u] = '?' THEN
         fs.name[u] := '?';

     FOR u := 0 TO 2 DO
       IF fn.ext[u] = '?' THEN
         fs.ext[u] := '?';

     IF a_dir[entrycount].flag = 0 THEN
       entrycount := $41;

  UNTIL (fs.name = fn.name) AND (fs.ext = fn.ext) AND (a_dir[entrycount].flag AND $80 = 0) OR (entrycount > $40);

  IF NOT (entrycount > $40) THEN
    A_FindNext := entrycount
  ELSE
    A_FindNext := 0;

END;

FUNCTION A_FindFirst (filen : STRING) : BYTE;

BEGIN
  entrycount := 0;
  A_FindFirst := A_FindNext (filen);
END;

BEGIN
  dir_read := FALSE;
  vtoc_read := FALSE;
  secprotrk := 18;
  secsize := 1;
  diskside := 0;
  drivenum := 0;
  entrycount := 0;
  a_error := 0;
END.